// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.

module internal FSharp.Compiler.CheckIncrementalClasses

open System

open FSharp.Compiler.Diagnostics
open Internal.Utilities.Collections
open Internal.Utilities.Library
open Internal.Utilities.Library.Extras
open FSharp.Compiler.CheckExpressions
open FSharp.Compiler.CheckBasics
open FSharp.Compiler.CheckPatterns
open FSharp.Compiler.CompilerGlobalState
open FSharp.Compiler.DiagnosticsLogger
open FSharp.Compiler.NameResolution
open FSharp.Compiler.Syntax
open FSharp.Compiler.SyntaxTreeOps
open FSharp.Compiler.Text
open FSharp.Compiler.Xml
open FSharp.Compiler.TcGlobals
open FSharp.Compiler.TypedTree
open FSharp.Compiler.TypedTreeBasics
open FSharp.Compiler.TypedTreeOps
open FSharp.Compiler.TypeHierarchy

type cenv = TcFileState

let TcClassRewriteStackGuardDepth = StackGuard.GetDepthOption "TcClassRewrite"

exception ParameterlessStructCtor of range: range

/// Represents a single group of bindings in a class with an implicit constructor
type IncrClassBindingGroup = 
    | IncrClassBindingGroup of bindings: Binding list * isStatic: bool* isRecursive: bool
    | IncrClassDo of expr: Expr * isStatic: bool * range: Range 

/// Typechecked info for implicit constructor and it's arguments 
type StaticCtorInfo = 
    {
        /// The TyconRef for the type being defined
        TyconRef: TyconRef

        /// The type parameters allocated for the implicit construction. 
        IncrCtorDeclaredTypars: Typars     

        /// The value representing the static implicit constructor.
        /// Lazy to ensure the static ctor value is only published if needed.
        StaticCtorValInfo: Lazy<Val list * Val * ValScheme>

        /// The name generator used to generate the names of fields etc. within the type.
        NameGenerator: NiceNameGenerator
    }
        
    /// Get the type parameters of the implicit constructor, after taking equi-recursive inference into account.
    member ctorInfo.GetNormalizedIncrCtorDeclaredTypars (cenv: cenv) denv m = 
        let g = cenv.g
        let ctorDeclaredTypars = ctorInfo.IncrCtorDeclaredTypars
        let ctorDeclaredTypars = ChooseCanonicalDeclaredTyparsAfterInference g denv ctorDeclaredTypars m
        ctorDeclaredTypars

/// Typechecked info for implicit constructor and it's arguments 
type IncrClassCtorInfo = 
    {
        /// The value representing the implicit constructor.
        InstanceCtorVal: Val

        /// The type of the implicit constructor, representing as a ValScheme.
        InstanceCtorValScheme: ValScheme
        
        /// The values representing the arguments to the implicit constructor.
        InstanceCtorArgs: Val list

        /// The reference cell holding the 'this' parameter within the implicit constructor so it can be referenced in the
        /// arguments passed to the base constructor
        InstanceCtorSafeThisValOpt: Val option

        /// Data indicating if safe-initialization checks need to be inserted for this type.
        InstanceCtorSafeInitInfo: SafeInitData

        /// The value representing the 'base' variable within the implicit instance constructor.
        InstanceCtorBaseValOpt: Val option

        /// The value representing the 'this' variable within the implicit instance constructor.
        InstanceCtorThisVal: Val

    }
        
/// Check and elaborate the "left hand side" of the implicit class construction 
/// syntax.
let TcStaticImplicitCtorInfo_Phase2A(cenv: cenv, env, tcref: TyconRef, m, copyOfTyconTypars) =

    let g = cenv.g

    // Add class typars to env 
    let env = AddDeclaredTypars CheckForDuplicateTypars copyOfTyconTypars env

    // We only generate the cctor on demand, because we don't need it if there are no cctor actions. 
    // The code below has a side-effect (MakeAndPublishVal), so we only want to run it once if at all. 
    // The .cctor is never referenced by any other code.
    let cctorValInfo = 
        lazy 
            let cctorArgs = [ fst(mkCompGenLocal m "unitVar" g.unit_ty) ]

            let cctorTy = mkFunTy g g.unit_ty g.unit_ty
            let valSynData = SynValInfo([[]], SynInfo.unnamedRetVal)
            let id = ident ("cctor", m)
            CheckForNonAbstractInterface g ModuleOrMemberBinding tcref ClassCtorMemberFlags false id.idRange
            let memberInfo = MakeMemberDataAndMangledNameForMemberVal(g, tcref, false, [], [], ClassCtorMemberFlags, valSynData, id, false)
            let prelimValReprInfo = TranslateSynValInfo cenv m (TcAttributes cenv env) valSynData
            let prelimTyschemeG = GeneralizedType(copyOfTyconTypars, cctorTy)
            let valReprInfo = InferGenericArityFromTyScheme prelimTyschemeG prelimValReprInfo
            let cctorValScheme = ValScheme(id, prelimTyschemeG, Some valReprInfo, None, Some memberInfo, false, ValInline.Never, NormalVal, Some (SynAccess.Private Range.Zero), false, true, false, false)
                 
            let cctorVal = MakeAndPublishVal cenv env (Parent tcref, false, ModuleOrMemberBinding, ValNotInRecScope, cctorValScheme, [(* no attributes*)], XmlDoc.Empty, None, false) 
            cctorArgs, cctorVal, cctorValScheme

    {   TyconRef = tcref
        IncrCtorDeclaredTypars = copyOfTyconTypars
        StaticCtorValInfo = cctorValInfo
        NameGenerator = NiceNameGenerator()
    }

/// Check and elaborate the "left hand side" of the implicit class construction 
/// syntax.
let TcImplicitCtorInfo_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, attrs, spats, thisIdOpt, baseValOpt: Val option, safeInitInfo, m, copyOfTyconTypars, objTy, thisTy, xmlDoc: PreXmlDoc) =

    let g = cenv.g
    let baseValOpt = 
        match GetSuperTypeOfType g cenv.amap m objTy with 
        | Some superTy -> MakeAndPublishBaseVal cenv env (match baseValOpt with None -> None | Some v -> Some v.Id) superTy
        | None -> None

    // Add class typars to env 
    let env = AddDeclaredTypars CheckForDuplicateTypars copyOfTyconTypars env

    // Type check arguments by processing them as 'simple' patterns 
    //     NOTE: if we allow richer patterns here this is where we'd process those patterns 
    let ctorArgNames, patEnv = TcSimplePatsOfUnknownType cenv true CheckCxs env tpenv (SynSimplePats.SimplePats (spats, [], m))

    let (TcPatLinearEnv(_, names, _)) = patEnv
        
    // Create the values with the given names 
    let _, vspecs = MakeAndPublishSimpleVals cenv env names

    if tcref.IsStructOrEnumTycon && isNil spats then 
        errorR (ParameterlessStructCtor(tcref.Range))
        
    // Put them in order 
    let ctorArgs = List.map (fun v -> NameMap.find v vspecs) ctorArgNames
    let safeThisValOpt = MakeAndPublishSafeThisVal cenv env thisIdOpt thisTy
        
    // NOTE: the type scheme here is not complete!!! The ctorTy is more or less 
    // just a type variable. The type and typars get fixed-up after inference 
    let ctorValScheme, ctorVal = 
        let argTy = mkRefTupledTy g (typesOfVals ctorArgs)

        // Initial type has known information 
        let ctorTy = mkFunTy g argTy objTy    

        // NOTE: no attributes can currently be specified for the implicit constructor 
        let attribs = TcAttributes cenv env (AttributeTargets.Constructor ||| AttributeTargets.Method) attrs
        let memberFlags = CtorMemberFlags
                                  
        let synArgInfos = List.map (SynInfo.InferSynArgInfoFromSimplePat []) spats
        let valSynData = SynValInfo([synArgInfos], SynInfo.unnamedRetVal)
        let id = ident ("new", m)

        CheckForNonAbstractInterface g ModuleOrMemberBinding tcref memberFlags false id.idRange
        let memberInfo = MakeMemberDataAndMangledNameForMemberVal(g, tcref, false, attribs, [], memberFlags, valSynData, id, false)
        let prelimValReprInfo = TranslateSynValInfo cenv m (TcAttributes cenv env) valSynData
        let prelimTyschemeG = GeneralizedType(copyOfTyconTypars, ctorTy)
        let isComplete = ComputeIsComplete copyOfTyconTypars [] ctorTy
        let varReprInfo = InferGenericArityFromTyScheme prelimTyschemeG prelimValReprInfo
        let ctorValScheme = ValScheme(id, prelimTyschemeG, Some varReprInfo, None, Some memberInfo, false, ValInline.Never, NormalVal, vis, false, true, false, false)
        let paramNames = varReprInfo.ArgNames

        let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
        let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, Some paramNames)
        let ctorVal = MakeAndPublishVal cenv env (Parent tcref, false, ModuleOrMemberBinding, ValInRecScope isComplete, ctorValScheme, attribs, xmlDoc, None, false) 
        ctorValScheme, ctorVal

    let thisVal = 
        // --- Create this for use inside constructor 
        let thisId = ident ("this", m)
        let thisValScheme = ValScheme(thisId, NonGenericTypeScheme thisTy, None, None, None, false, ValInline.Never, CtorThisVal, None, true, false, false, false)
        let thisVal = MakeAndPublishVal cenv env (ParentNone, false, ClassLetBinding false, ValNotInRecScope, thisValScheme, [], XmlDoc.Empty, None, false)
        thisVal

    {   InstanceCtorArgs = ctorArgs
        InstanceCtorVal = ctorVal
        InstanceCtorValScheme = ctorValScheme
        InstanceCtorBaseValOpt = baseValOpt
        InstanceCtorSafeThisValOpt = safeThisValOpt
        InstanceCtorSafeInitInfo = safeInitInfo
        InstanceCtorThisVal = thisVal
    }


// Partial class defns - local val mapping to fields
      
/// Create the field for a "let" binding in a type definition.
///
/// The "v" is the local typed w.r.t. tyvars of the implicit ctor.
/// The formalTyparInst does the formal-typars/implicit-ctor-typars subst.
/// Field specifications added to a tcref must be in terms of the tcrefs formal typars.
let private MakeIncrClassField(g, cpath, formalTyparInst: TyparInstantiation, v: Val, isStatic, rfref: RecdFieldRef) =
    let name = rfref.FieldName
    let id = ident (name, v.Range)
    let ty = v.Type |> instType formalTyparInst
    let taccess = TAccess [cpath]
    let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute v.Attribs

    Construct.NewRecdField isStatic None id false ty v.IsMutable isVolatile [] v.Attribs v.XmlDoc taccess true

/// Indicates how is a 'let' bound value in a class with implicit construction is represented in
/// the TAST ultimately produced by type checking.    
type IncrClassValRepr = 

    // e.g representation for 'let v = 3' if it is not used in anything given a method representation
    | InVar of isArg: bool 

    // e.g representation for 'let v = 3'
    | InField of isStatic: bool * staticCountForSafeInit: int * fieldRef: RecdFieldRef

    // e.g representation for 'let f x = 3'
    | InMethod of isStatic:bool * value: Val * valReprInfo: ValReprInfo

/// IncrClassReprInfo represents the decisions we make about the representation of 'let' and 'do' bindings in a
/// type defined with implicit class construction.
type IncrClassReprInfo = 
    { 
        /// Indicates the set of field names taken within one incremental class
        TakenFieldNames: Set<string>
          
        RepInfoTcGlobals: TcGlobals
          
        /// vals mapped to representations
        ValReprs: Zmap<Val, IncrClassValRepr> 
          
        /// vals represented as fields or members from this point on 
        ValsWithRepresentation: Zset<Val> 
    }

    static member Empty(g, names) = 
        {   TakenFieldNames=Set.ofList names
            RepInfoTcGlobals=g
            ValReprs = Zmap.empty valOrder 
            ValsWithRepresentation = Zset.empty valOrder }

    /// Find the representation of a value
    member localRep.LookupRepr (v: Val) = 
        match Zmap.tryFind v localRep.ValReprs with 
        | None -> error(InternalError("LookupRepr: failed to find representation for value", v.Range))
        | Some res -> res

    static member IsMethodRepr (cenv: cenv) (bind: Binding) = 
        let g = cenv.g
        let v = bind.Var
        // unit fields are not stored, just run rhs for effects
        if isUnitTy g v.Type then 
            false
        else 
            let arity = InferValReprInfoOfBinding g AllowTypeDirectedDetupling.Yes v bind.Expr 
            not arity.HasNoArgs && not v.IsMutable


    /// <summary>
    /// Choose how a binding is represented
    /// </summary>
    /// <param name='cenv'></param>
    /// <param name='env'></param>
    /// <param name='isStatic'></param>
    /// <param name='isCtorArg'></param>
    /// <param name='staticCtorInfo'></param>
    /// <param name='ctorInfoOpt'></param>
    /// <param name='staticForcedFieldVars'>The vars forced to be fields due to static member bindings, instance initialization expressions or instance member bindings</param>
    /// <param name='instanceForcedFieldVars'>The vars forced to be fields due to instance member bindings</param>
    /// <param name='takenFieldNames'></param>
    /// <param name='bind'></param>
    member localRep.ChooseRepresentation (cenv: cenv, env: TcEnv, isStatic, isCtorArg,
                                            staticCtorInfo: StaticCtorInfo,
                                            ctorInfoOpt: IncrClassCtorInfo option,
                                            staticForcedFieldVars: FreeLocals,
                                            instanceForcedFieldVars: FreeLocals, 
                                            takenFieldNames: Set<string>, 
                                            bind: Binding) = 
        let g = cenv.g 
        let v = bind.Var
        let relevantForcedFieldVars = (if isStatic then staticForcedFieldVars else instanceForcedFieldVars)
            
        let tcref = staticCtorInfo.TyconRef
        let name, takenFieldNames = 

            let isNameTaken = 
                // Check if a implicit field already exists with this name
                takenFieldNames.Contains(v.LogicalName) ||
                // Check if a user-defined field already exists with this name. Struct fields have already been created - see bug FSharp 1.0 5304
                (tcref.GetFieldByName(v.LogicalName).IsSome && (isStatic || not tcref.IsFSharpStructOrEnumTycon)) 

            let nm = 
                if isNameTaken then 
                    staticCtorInfo.NameGenerator.FreshCompilerGeneratedName (v.LogicalName, v.Range)
                else 
                    v.LogicalName
            nm, takenFieldNames.Add nm
                 
        let reportIfUnused() = 
            if not v.HasBeenReferenced && not v.IsCompiledAsTopLevel && not (v.DisplayName.StartsWithOrdinal("_")) && not v.IsCompilerGenerated then 
                warning (Error(FSComp.SR.chkUnusedValue(v.DisplayName), v.Range))

        let repr = 
            match InferValReprInfoOfBinding g AllowTypeDirectedDetupling.Yes v bind.Expr with 
            | arity when arity.HasNoArgs || v.IsMutable -> 
                // all mutable variables are forced into fields, since they may escape into closures within the implicit constructor
                // e.g. 
                //     type C() =  
                //        let mutable m = 1
                //        let n = ... (fun () -> m) ....
                //
                // All struct variables are forced into fields. Structs may not contain "let" bindings, so no new variables can be 
                // introduced.
                    
                if v.IsMutable || relevantForcedFieldVars.Contains v || tcref.IsStructOrEnumTycon then 
                    //dprintfn "Representing %s as a field %s" v.LogicalName name
                    let rfref = RecdFieldRef(tcref, name)
                    reportIfUnused()
                    InField (isStatic, localRep.ValReprs.Count, rfref)
                else
                    //if not v.Attribs.IsEmpty then 
                    //    warning(Error(FSComp.SR.tcAttributesIgnoredOnLetBinding(), v.Range))
                    //dprintfn 
                    //    "Representing %s as a local variable %s, staticForcedFieldVars = %s, instanceForcedFieldVars = %s" 
                    //    v.LogicalName name 
                    //    (staticForcedFieldVars |> Seq.map (fun v -> v.LogicalName) |> String.concat ",")
                    //    (instanceForcedFieldVars |> Seq.map (fun v -> v.LogicalName) |> String.concat ",")
                    InVar isCtorArg
            | valReprInfo -> 
                //dprintfn "Representing %s as a method %s" v.LogicalName name
                let tps, _, argInfos, _, _ = GetValReprTypeInCompiledForm g valReprInfo 0 v.Type v.Range

                let valSynInfo = SynValInfo(argInfos |> List.mapSquared (fun (_, argInfo) -> SynArgInfo([], false, argInfo.Name)), SynInfo.unnamedRetVal)
                let memberFlags = (if isStatic then StaticMemberFlags else NonVirtualMemberFlags) SynMemberKind.Member
                let id = mkSynId v.Range name
                let memberInfo = MakeMemberDataAndMangledNameForMemberVal(g, tcref, false, [], [], memberFlags, valSynInfo, mkSynId v.Range name, true)

                let copyOfTyconTypars = staticCtorInfo.GetNormalizedIncrCtorDeclaredTypars cenv env.DisplayEnv staticCtorInfo.TyconRef.Range
                
                AdjustValToHaveValReprInfo v (Parent tcref) valReprInfo

                // Add the 'this' pointer on to the function
                let memberTauTy, valReprInfo = 
                    let tauTy = v.TauType
                    if isStatic then 
                        tauTy, valReprInfo 
                    else 
                        match ctorInfoOpt with
                        | None -> tauTy, valReprInfo
                        | Some ctorInfo ->
                            let tauTy = mkFunTy g ctorInfo.InstanceCtorThisVal.Type v.TauType
                            let (ValReprInfo(tpNames, args, ret)) = valReprInfo
                            let valReprInfo = ValReprInfo(tpNames, ValReprInfo.selfMetadata :: args, ret)
                            tauTy, valReprInfo

                // Add the enclosing type parameters on to the function
                let valReprInfo = 
                    let (ValReprInfo(tpNames, args, ret)) = valReprInfo
                    ValReprInfo(tpNames@ValReprInfo.InferTyparInfo copyOfTyconTypars, args, ret)
                                          
                let prelimTyschemeG = GeneralizedType(copyOfTyconTypars@tps, memberTauTy)

                // NOTE: putting isCompilerGenerated=true here is strange.  The method is not public, nor is
                // it a "member" in the F# sense, but the F# spec says it is generated and it is reasonable to reflect on it.
                let memberValScheme = ValScheme(id, prelimTyschemeG, Some valReprInfo, None, Some memberInfo, false, ValInline.Never, NormalVal, None, true (* isCompilerGenerated *), true (* isIncrClass *), false, false)

                let methodVal = MakeAndPublishVal cenv env (Parent tcref, false, ModuleOrMemberBinding, ValNotInRecScope, memberValScheme, v.Attribs, XmlDoc.Empty, None, false) 

                reportIfUnused()
                InMethod(isStatic, methodVal, valReprInfo)

        repr, takenFieldNames

    /// Extend the known local representations by choosing a representation for a binding
    member localRep.ChooseAndAddRepresentation(cenv, env, isStatic, isCtorArg, staticCtorInfo, ctorInfoOpt, staticForcedFieldVars, instanceForcedFieldVars, bind: Binding) = 
        let v = bind.Var
        let repr, takenFieldNames = localRep.ChooseRepresentation (cenv, env, isStatic, isCtorArg, staticCtorInfo, ctorInfoOpt, staticForcedFieldVars, instanceForcedFieldVars, localRep.TakenFieldNames, bind )
        // OK, representation chosen, now add it 
        {localRep with 
            TakenFieldNames=takenFieldNames 
            ValReprs = Zmap.add v repr localRep.ValReprs}  

    member localRep.ValNowWithRepresentation (v: Val) = 
        {localRep with ValsWithRepresentation = Zset.add v localRep.ValsWithRepresentation}

    member localRep.IsValWithRepresentation (v: Val) = 
            localRep.ValsWithRepresentation.Contains v 

    member localRep.IsValRepresentedAsLocalVar (v: Val) =
        match localRep.LookupRepr v with 
        | InVar false -> true
        | _ -> false

    member localRep.IsValRepresentedAsMethod (v: Val) =
        localRep.IsValWithRepresentation v &&
        match localRep.LookupRepr v with 
        | InMethod _ -> true 
        | _ -> false

    /// Make the elaborated expression that represents a use of a 
    /// a "let v = ..." class binding
    member localRep.MakeValueLookup thisValOpt tinst safeStaticInitInfo v tyargs m =
        let g = localRep.RepInfoTcGlobals 
        match localRep.LookupRepr v, thisValOpt with 
        | InVar _, _ -> 
            exprForVal m v
        | InField(false, _idx, rfref), Some thisVal -> 
            let thise = exprForVal m thisVal
            mkRecdFieldGetViaExprAddr (thise, rfref, tinst, m)
        | InField(false, _idx, _rfref), None -> 
            error(InternalError("Unexpected missing 'this' variable in MakeValueLookup", m))
        | InField(true, idx, rfref), _ -> 
            let expr = mkStaticRecdFieldGet (rfref, tinst, m)
            MakeCheckSafeInit g tinst safeStaticInitInfo (mkInt g m idx) expr
                
        | InMethod(isStatic, methodVal, valReprInfo), _ -> 
            //dprintfn "Rewriting application of %s to be call to method %s" v.LogicalName methodVal.LogicalName
            let expr, exprTy = AdjustValForExpectedValReprInfo g m (mkLocalValRef methodVal) NormalValUse valReprInfo 
            // Prepend the the type arguments for the class
            let tyargs = tinst @ tyargs 
            let thisArgs =
                if isStatic then []
                else Option.toList (Option.map (exprForVal m) thisValOpt)
                    
            MakeApplicationAndBetaReduce g (expr, exprTy, [tyargs], thisArgs, m) 

    /// Make the elaborated expression that represents an assignment 
    /// to a "let mutable v = ..." class binding
    member localRep.MakeValueAssign thisValOpt tinst safeStaticInitInfo v expr m =
        let g = localRep.RepInfoTcGlobals 
        match localRep.LookupRepr v, thisValOpt with 
        | InField(false, _, rfref), Some thisVal -> 
            let thise = exprForVal m thisVal
            mkRecdFieldSetViaExprAddr(thise, rfref, tinst, expr, m)
        | InField(false, _, _rfref), None -> 
            error(InternalError("Unexpected missing 'this' variable in MakeValueAssign", m))
        | InVar _, _ -> 
            mkValSet m (mkLocalValRef v) expr
        | InField (true, idx, rfref), _ -> 
            let expr = mkStaticRecdFieldSet(rfref, tinst, expr, m)
            MakeCheckSafeInit g tinst safeStaticInitInfo (mkInt g m idx) expr
        | InMethod _, _ -> 
            error(InternalError("Local was given method storage, yet later it's been assigned to", m))
          
    member localRep.MakeValueGetAddress readonly thisValOpt tinst safeStaticInitInfo v m =
        let g = localRep.RepInfoTcGlobals 
        match localRep.LookupRepr v, thisValOpt with 
        | InField(false, _, rfref), Some thisVal -> 
            let thise = exprForVal m thisVal
            mkRecdFieldGetAddrViaExprAddr(readonly, thise, rfref, tinst, m)
        | InField(false, _, _rfref), None -> 
            error(InternalError("Unexpected missing 'this' variable in MakeValueGetAddress", m))
        | InField(true, idx, rfref), _ -> 
            let expr = mkStaticRecdFieldGetAddr(readonly, rfref, tinst, m)
            MakeCheckSafeInit g tinst safeStaticInitInfo (mkInt g m idx) expr
        | InVar _, _ -> 
            mkValAddr m readonly (mkLocalValRef v)
        | InMethod _, _ -> 
            error(InternalError("Local was given method storage, yet later it's address was required", m))

    /// Mutate a type definition by adding fields 
    /// Used as part of processing "let" bindings in a type definition. 
    member localRep.PublishIncrClassFields (cenv, denv, cpath, staticCtorInfo: StaticCtorInfo, safeStaticInitInfo) =    
        let tcref = staticCtorInfo.TyconRef
        let rfspecs = 
            [ for KeyValue(v, repr) in localRep.ValReprs do
                    match repr with 
                    | InField(isStatic, _, rfref) -> 
                        // Instance fields for structs are published earlier because the full set of fields is determined syntactically from the implicit
                        // constructor arguments. This is important for the "default value" and "does it have an implicit default constructor" 
                        // semantic conditions for structs - see bug FSharp 1.0 5304.
                        if isStatic || not tcref.IsFSharpStructOrEnumTycon then 
                            let ctorDeclaredTypars = staticCtorInfo.GetNormalizedIncrCtorDeclaredTypars cenv denv staticCtorInfo.TyconRef.Range

                            // Note: tcrefObjTy contains the original "formal" typars, thisTy is the "fresh" one... f<>fresh. 
                            let revTypeInst = List.zip ctorDeclaredTypars (tcref.TyparsNoRange |> List.map mkTyparTy)

                            yield MakeIncrClassField(localRep.RepInfoTcGlobals, cpath, revTypeInst, v, isStatic, rfref)
                    | _ -> 
                        () 

              match safeStaticInitInfo with 
              | SafeInitField (_, fld) -> yield fld
              | NoSafeInitInfo -> () ]

        let allFields = rfspecs @ tcref.AllFieldsAsList
        match allFields with
        | [] -> ()
        | _ ->
            match tcref.TypeReprInfo with
            | TILObjectRepr _ -> ()
            | TFSharpTyconRepr info ->
                let recdFields = Construct.MakeRecdFieldsTable (rfspecs @ tcref.AllFieldsAsList)

                // Mutate the entity_tycon_repr to publish the fields
                tcref.Deref.entity_tycon_repr <- TFSharpTyconRepr { info with fsobjmodel_rfields = recdFields}
            | _ -> 
                errorR(InternalError("unreachable, anything that can have fields should be a TFSharpTyconRepr", tcref.Range))

    /// Given localRep saying how locals have been represented, e.g. as fields.
    /// Given an expr under a given thisVal context.
    //
    // Fix up the references to the locals, e.g.
    //     v -> this.fieldv
    //     f x -> this.method x
    member localRep.FixupIncrClassExprPhase2C cenv thisValOpt safeStaticInitInfo (thisTyInst: TypeInst) expr = 
        // fixup: intercept and expr rewrite
        let FixupExprNode rw e =
            //dprintfn "Fixup %s" (showL (exprL e))
            let g = localRep.RepInfoTcGlobals
            let e = NormalizeAndAdjustPossibleSubsumptionExprs g e
            match e with
            // Rewrite references to applied let-bound-functions-compiled-as-methods
            // Rewrite references to applied recursive let-bound-functions-compiled-as-methods
            // Rewrite references to applied recursive generic let-bound-functions-compiled-as-methods
            | Expr.App (Expr.Val (ValDeref v, _, _), _, tyargs, args, m) 
            | Expr.App (Expr.Link {contents = Expr.Val (ValDeref v, _, _) }, _, tyargs, args, m)  
            | Expr.App (Expr.Link {contents = Expr.App (Expr.Val (ValDeref v, _, _), _, tyargs, [], _) }, _, [], args, m)  
                    when localRep.IsValRepresentedAsMethod v && not (cenv.recUses.ContainsKey v) -> 

                    let expr = localRep.MakeValueLookup thisValOpt thisTyInst safeStaticInitInfo v tyargs m
                    let args = args |> List.map rw
                    Some (MakeApplicationAndBetaReduce g (expr, (tyOfExpr g expr), [], args, m)) 

            // Rewrite references to values stored as fields and first class uses of method values
            | Expr.Val (ValDeref v, _, m)                         
                when localRep.IsValWithRepresentation v -> 

                    //dprintfn "Found use of %s" v.LogicalName
                    Some (localRep.MakeValueLookup thisValOpt thisTyInst safeStaticInitInfo v [] m)

            // Rewrite assignments to mutable values stored as fields 
            | Expr.Op (TOp.LValueOp (LSet, ValDeref v), [], [arg], m) 
                when localRep.IsValWithRepresentation v ->
                    let arg = rw arg 
                    Some (localRep.MakeValueAssign thisValOpt thisTyInst safeStaticInitInfo v arg m)

            // Rewrite taking the address of mutable values stored as fields 
            | Expr.Op (TOp.LValueOp (LAddrOf readonly, ValDeref v), [], [], m) 
                when localRep.IsValWithRepresentation v ->
                    Some (localRep.MakeValueGetAddress readonly thisValOpt thisTyInst safeStaticInitInfo v m)

            | _ -> None

        RewriteExpr {   PreIntercept = Some FixupExprNode 
                        PostTransform = (fun _ -> None)
                        PreInterceptBinding = None
                        RewriteQuotations = true
                        StackGuard = StackGuard(TcClassRewriteStackGuardDepth, "FixupIncrClassExprPhase2C") } expr 

type IncrClassConstructionBindingsPhase2C =
    | Phase2CBindings of IncrClassBindingGroup list
    | Phase2CCtorJustAfterSuperInit     
    | Phase2CCtorJustAfterLastLet    

/// Given a set of 'let' bindings (static or not, recursive or not) that make up a class,
/// generate their initialization expression(s).
let MakeCtorForIncrClassConstructionPhase2C(
    cenv: cenv, 
    env: TcEnv,
    staticCtorInfo: StaticCtorInfo,
    instanceInfo: (IncrClassCtorInfo * Expr * bool) option,
    decs: IncrClassConstructionBindingsPhase2C list, 
    memberBinds: Binding list,
    generalizedTyparsForRecursiveBlock, 
    safeStaticInitInfo: SafeInitData
) = 


    let denv = env.DisplayEnv 
    let g = cenv.g

    let thisValOpt =
        match instanceInfo with
        | None -> None
        | Some (ctorInfo, _, _) -> Some ctorInfo.InstanceCtorThisVal 

    let ctorInfoOpt =
        match instanceInfo with
        | None -> None
        | Some (ctorInfo, _, _) -> Some ctorInfo

    let m =
        match thisValOpt with
        | Some thisVal -> thisVal.Range
        | None -> staticCtorInfo.TyconRef.Range

    let ctorDeclaredTypars = staticCtorInfo.GetNormalizedIncrCtorDeclaredTypars cenv denv m

    ctorDeclaredTypars |> List.iter (SetTyparRigid env.DisplayEnv m)  

    // Reconstitute the type with the correct quantified type variables.
    match instanceInfo with
    | Some (ctorInfo, _, _) -> ctorInfo.InstanceCtorVal.SetType (mkForallTyIfNeeded ctorDeclaredTypars ctorInfo.InstanceCtorVal.TauType)
    | None -> ()

    let freeChoiceTypars = ListSet.subtract typarEq generalizedTyparsForRecursiveBlock ctorDeclaredTypars

    let thisTyInst = List.map mkTyparTy ctorDeclaredTypars

    let accFreeInExpr acc expr =
        unionFreeVars acc (freeInExpr CollectLocalsNoCaching expr) 
            
    let accFreeInBinding acc (bind: Binding) = 
        accFreeInExpr acc bind.Expr
            
    let accFreeInBindings acc (binds: Binding list) = 
        (acc, binds) ||> List.fold accFreeInBinding

    // Find all the variables used in any method. These become fields.
    //   staticForcedFieldVars: FreeLocals: the vars forced to be fields due to static member bindings, instance initialization expressions or instance member bindings
    //   instanceForcedFieldVars: FreeLocals: the vars forced to be fields due to instance member bindings
                                            
    let staticForcedFieldVars, instanceForcedFieldVars = 
            let staticForcedFieldVars, instanceForcedFieldVars = 
                ((emptyFreeVars, emptyFreeVars), decs) ||> List.fold (fun (staticForcedFieldVars, instanceForcedFieldVars) dec -> 
                match dec with 
                | Phase2CCtorJustAfterLastLet
                | Phase2CCtorJustAfterSuperInit ->  
                    (staticForcedFieldVars, instanceForcedFieldVars)
                | Phase2CBindings decs ->
                    ((staticForcedFieldVars, instanceForcedFieldVars), decs) ||> List.fold (fun (staticForcedFieldVars, instanceForcedFieldVars) dec -> 
                        match dec with 
                        | IncrClassBindingGroup(binds, isStatic, _) -> 
                            let methodBinds = binds |> List.filter (IncrClassReprInfo.IsMethodRepr cenv) 
                            let staticForcedFieldVars = 
                                if isStatic then 
                                    // Any references to static variables in any static method force the variable to be represented as a field
                                    (staticForcedFieldVars, methodBinds) ||> accFreeInBindings
                                else
                                    // Any references to static variables in any instance bindings force the variable to be represented as a field
                                    (staticForcedFieldVars, binds) ||> accFreeInBindings
                                        
                            let instanceForcedFieldVars = 
                                // Any references to instance variables in any methods force the variable to be represented as a field
                                (instanceForcedFieldVars, methodBinds) ||> accFreeInBindings
                                        
                            (staticForcedFieldVars, instanceForcedFieldVars)
                        | IncrClassDo (e, isStatic, _) -> 
                            let staticForcedFieldVars = 
                                if isStatic then 
                                    staticForcedFieldVars
                                else
                                    unionFreeVars staticForcedFieldVars (freeInExpr CollectLocalsNoCaching e)
                            (staticForcedFieldVars, instanceForcedFieldVars)))
            let staticForcedFieldVars = (staticForcedFieldVars, memberBinds) ||> accFreeInBindings 
            let instanceForcedFieldVars = (instanceForcedFieldVars, memberBinds) ||> accFreeInBindings 
             
            // Any references to static variables in the 'inherits' expression force those static variables to be represented as fields
            let staticForcedFieldVars =
                match instanceInfo with 
                | Some (_, inheritsExpr, _) -> (staticForcedFieldVars, inheritsExpr) ||> accFreeInExpr
                | None -> staticForcedFieldVars

            (staticForcedFieldVars.FreeLocals, instanceForcedFieldVars.FreeLocals)


    // Compute the implicit construction side effects of single 
    // 'let' or 'let rec' binding in the implicit class construction sequence 
    let TransBind (reps: IncrClassReprInfo) (TBind(v, rhsExpr, spBind)) =
        if v.MustInline then
            error(Error(FSComp.SR.tcLocalClassBindingsCannotBeInline(), v.Range))
        let rhsExpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt safeStaticInitInfo thisTyInst rhsExpr
            
        // The initialization of the 'ref cell' variable for 'this' is the only binding which comes prior to the super init
        let isPriorToSuperInit = 
            match instanceInfo with
            | None -> false
            | Some (ctorInfo, _, _) -> 
                match ctorInfo.InstanceCtorSafeThisValOpt with 
                | None -> false
                | Some v2 -> valEq v v2
                            
        match reps.LookupRepr v with
        | InMethod(isStatic, methodVal, _) -> 
            let _, chooseTps, tauExpr, tauTy, m = 
                match rhsExpr with 
                | Expr.TyChoose (chooseTps, b, _) -> [], chooseTps, b, (tyOfExpr g b), m 
                | Expr.TyLambda (_, tps, Expr.TyChoose (chooseTps, b, _), m, returnTy) -> tps, chooseTps, b, returnTy, m 
                | Expr.TyLambda (_, tps, b, m, returnTy) -> tps, [], b, returnTy, m 
                | e -> [], [], e, (tyOfExpr g e), e.Range
                    
            let chooseTps = chooseTps @ (ListSet.subtract typarEq freeChoiceTypars methodVal.Typars)

            // Add the 'this' variable as an argument
            let tauExpr, tauTy = 
                if isStatic then 
                    tauExpr, tauTy
                else
                    match thisValOpt with
                    | None -> tauExpr, tauTy
                    | Some thisVal ->
                        let e = mkLambda m thisVal (tauExpr, tauTy)
                        e, tyOfExpr g e

            // Replace the type parameters that used to be on the rhs with 
            // the full set of type parameters including the type parameters of the enclosing class
            let rhsExpr = mkTypeLambda m methodVal.Typars (mkTypeChoose m chooseTps tauExpr, tauTy)
            (isPriorToSuperInit, id), [TBind (methodVal, rhsExpr, spBind)]
            
        // If it's represented as a non-escaping local variable then just bind it to its value
        // If it's represented as a non-escaping local arg then no binding necessary (ctor args are already bound)
            
        | InVar isArg ->
            (isPriorToSuperInit, (fun e -> if isArg then e else mkLetBind m (TBind(v, rhsExpr, spBind)) e)), []

        | InField (isStatic, idx, _) ->
                // Use spBind if it available as the span for the assignment into the field
            let m =
                    match spBind, rhsExpr with 
                    // Don't generate big sequence points for functions in classes
                    | _, (Expr.Lambda _ | Expr.TyLambda _) -> v.Range
                    | DebugPointAtBinding.Yes m, _ -> m 
                    | _ -> v.Range

            if isStatic = false && thisValOpt.IsNone then
                (isPriorToSuperInit, id), []
            else
                let assignExpr = reps.MakeValueAssign thisValOpt thisTyInst NoSafeInitInfo v rhsExpr m

                let adjustSafeInitFieldExprOpt = 
                    if isStatic then 
                        match safeStaticInitInfo with 
                        | SafeInitField (rfref, _) -> 
                            let setExpr = mkStaticRecdFieldSet (rfref, thisTyInst, mkInt g m idx, m)
                            let setExpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt NoSafeInitInfo thisTyInst setExpr
                            Some setExpr
                        | NoSafeInitInfo -> 
                            None
                    else
                        None

                (isPriorToSuperInit, (fun e -> 
                        let e =
                            match adjustSafeInitFieldExprOpt with
                            | None -> e
                            | Some adjustExpr -> mkCompGenSequential m adjustExpr e

                        let assignExpr =
                            match spBind with
                            | DebugPointAtBinding.Yes _ -> mkDebugPoint m assignExpr
                            | _ -> assignExpr

                        mkSequential m assignExpr e)), []

    /// Work out the implicit construction side effects of a 'let', 'let rec' or 'do' 
    /// binding in the implicit class construction sequence 
    let TransTrueDec isCtorArg (reps: IncrClassReprInfo) dec = 
            match dec with 
            | IncrClassBindingGroup(binds, isStatic, isRec) ->
                let actions, reps, methodBinds = 
                    let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ChooseAndAddRepresentation(cenv, env, isStatic, isCtorArg, staticCtorInfo, ctorInfoOpt, staticForcedFieldVars, instanceForcedFieldVars, bind)) // extend
                    if isRec then
                        // Note: the recursive calls are made via members on the object
                        // or via access to fields. This means the recursive loop is "broken", 
                        // and we can collapse to sequential bindings 
                        let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ValNowWithRepresentation bind.Var) // in scope before
                        let actions, methodBinds = binds |> List.map (TransBind reps) |> List.unzip // since can occur in RHS of own defns 
                        actions, reps, methodBinds
                    else 
                        let actions, methodBinds = binds |> List.map (TransBind reps) |> List.unzip
                        let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ValNowWithRepresentation bind.Var) // in scope after
                        actions, reps, methodBinds
                let methodBinds = List.concat methodBinds
                if isStatic then 
                    (actions, [], methodBinds), reps
                else 
                    ([], actions, methodBinds), reps

            | IncrClassDo (doExpr, isStatic, mFull) -> 
                let doExpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt safeStaticInitInfo thisTyInst doExpr
                // Extend the range of any immediate debug point to include the 'do'
                let doExpr =
                    match doExpr with
                    | Expr.DebugPoint(_, innerExpr) -> Expr.DebugPoint(DebugPointAtLeafExpr.Yes mFull, innerExpr)
                    | e -> e
                let binder = (fun e -> mkSequential mFull doExpr e)
                let isPriorToSuperInit = false
                if isStatic then 
                    ([(isPriorToSuperInit, binder)], [], []), reps
                else 
                    ([], [(isPriorToSuperInit, binder)], []), reps


    /// Work out the implicit construction side effects of each declaration 
    /// in the implicit class construction sequence 
    let TransDec (reps: IncrClassReprInfo) dec = 
        match dec with 
        // The call to the base class constructor is done so we can set the ref cell 
        | Phase2CCtorJustAfterSuperInit ->  
            let binders = 
                [ match instanceInfo with
                  | None -> ()
                  | Some (ctorInfo, _, _) ->
                    match ctorInfo.InstanceCtorSafeThisValOpt with 
                    | None -> ()
                    | Some v -> 
                    let setExpr = mkRefCellSet g m ctorInfo.InstanceCtorThisVal.Type (exprForVal m v) (exprForVal m ctorInfo.InstanceCtorThisVal)
                    let setExpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt safeStaticInitInfo thisTyInst setExpr
                    let binder = (fun e -> mkSequential setExpr.Range setExpr e)
                    let isPriorToSuperInit = false
                    yield (isPriorToSuperInit, binder) ]

            ([], binders, []), reps

        // The last 'let' binding is done so we can set the initialization condition for the collection of object fields
        // which now allows members to be called.
        | Phase2CCtorJustAfterLastLet ->  
            let binders = 
                [ match instanceInfo with
                  | None -> ()
                  | Some (ctorInfo, _, _) ->
                  match ctorInfo.InstanceCtorSafeInitInfo with 
                  | SafeInitField (rfref, _) ->  
                    let setExpr = mkRecdFieldSetViaExprAddr (exprForVal m ctorInfo.InstanceCtorThisVal, rfref, thisTyInst, mkOne g m, m)
                    let setExpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt safeStaticInitInfo thisTyInst setExpr
                    let binder = (fun e -> mkSequential setExpr.Range setExpr e)
                    let isPriorToSuperInit = false
                    yield (isPriorToSuperInit, binder)  
                  | NoSafeInitInfo ->  
                    () ]

            ([], binders, []), reps
                
        | Phase2CBindings decs -> 
            let initActions, reps = List.mapFold (TransTrueDec false) reps decs 
            let cctorInitActions, ctorInitActions, methodBinds = List.unzip3 initActions
            (List.concat cctorInitActions, List.concat ctorInitActions, List.concat methodBinds), reps 

    let takenFieldNames = 
        [ for b in memberBinds do 
            b.Var.CompiledName g.CompilerGlobalState
            b.Var.DisplayName 
            b.Var.DisplayNameCoreMangled 
            b.Var.LogicalName ] 

    let reps = IncrClassReprInfo.Empty(g, takenFieldNames)

    // Bind the IsArg(true) representations of the object constructor arguments and assign them to fields
    // if they escape to the members. We do this by running the instance bindings 'let x = x' through TransTrueDec
    // for each constructor argument 'x', but with the special flag 'isCtorArg', which helps TransBind know that 
    // the value is already available as an argument, and that nothing special needs to be done unless the 
    // value is being stored into a field.
    let (cctorInitActions1, ctorInitActions1, methodBinds1), reps = 
        let binds =
            match instanceInfo with
            | None -> []
            | Some (ctorInfo, _, _) ->
                ctorInfo.InstanceCtorArgs |> List.map (fun v -> mkInvisibleBind v (exprForVal v.Range v))
        TransTrueDec true reps (IncrClassBindingGroup(binds, false, false))

    // We expect that only ctorInitActions1 will be non-empty here, and even then only if some elements are stored in the field
    assert (isNil cctorInitActions1)
    assert (isNil methodBinds1)

    // Now deal with all the 'let' and 'member' declarations
    let initActions, reps = List.mapFold TransDec reps decs
    let cctorInitActions2, ctorInitActions2, methodBinds2 = List.unzip3 initActions
    let cctorInitActions = cctorInitActions1 @ List.concat cctorInitActions2
    let ctorInitActions = ctorInitActions1 @ List.concat ctorInitActions2
    let methodBinds = methodBinds1 @ List.concat methodBinds2

    let ctorBodyOpt =
        match instanceInfo with
        | None -> None
        | Some (ctorInfo, inheritsExpr, inheritsIsVisible) ->
        // Build the elements of the implicit constructor body, starting from the bottom
        //     <optional-this-ref-cell-init>
        //     <super init>
        //     <let/do bindings>
        //     return ()
        let ctorInitActionsPre, ctorInitActionsPost = ctorInitActions |> List.partition fst

        // This is the return result
        let ctorBody = mkUnit g m

        // Add <optional-this-ref-cell-init>.
        // That is, add any <let/do bindings> that come prior to the super init constructor call, 
        // This is only ever at most the init of the InstanceCtorSafeThisValOpt and InstanceCtorSafeInitInfo var/field
        let ctorBody = List.foldBack (fun (_, binder) acc -> binder acc) ctorInitActionsPost ctorBody
            
        // Add the <super init>
        let ctorBody = 
            // The inheritsExpr may refer to the this variable or to incoming arguments, e.g. in closure fields.
            // References to the this variable go via the ref cell that gets created to help ensure coherent initialization.
            // This ref cell itself may be stored in a field of the object and accessed via arg0.
            // Likewise the incoming arguments will eventually be stored in fields and accessed via arg0.
            // 
            // As a result, the most natural way to implement this would be to simply capture arg0 if needed
            // and access all variables via that. This would be done by rewriting the inheritsExpr as follows:
            //    let inheritsExpr = reps.FixupIncrClassExprPhase2C thisValOpt thisTyInst inheritsExpr
            // However, the rules of IL mean we are not actually allowed to capture arg0 
            // and store it as a closure field before the base class constructor is called.
            // 
            // As a result we do not rewrite the inheritsExpr and instead 
            //    (a) wrap a let binding for the ref cell around the inheritsExpr if needed
            //    (b) rely on the fact that the input arguments are in scope and can be accessed from as argument variables
            //    (c) rely on the fact that there are no 'let' bindings prior to the inherits expr.
            let inheritsExpr = 
                match ctorInfo.InstanceCtorSafeThisValOpt with 
                | Some v when not (reps.IsValRepresentedAsLocalVar v) -> 
                    // Rewrite the expression to convert it to a load of a field if needed.
                    // We are allowed to load fields from our own object even though we haven't called
                    // the super class constructor yet.
                    let ldexpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt safeStaticInitInfo thisTyInst (exprForVal m v) 
                    mkInvisibleLet m v ldexpr inheritsExpr
                | _ -> 
                    inheritsExpr

            // Add the debug point
            let inheritsExpr =
                if inheritsIsVisible then
                    Expr.DebugPoint(DebugPointAtLeafExpr.Yes inheritsExpr.Range, inheritsExpr)
                else
                    inheritsExpr
                
            mkSequential m inheritsExpr ctorBody

        // Add the normal <let/do bindings> 
        let ctorBody = List.foldBack (fun (_, binder) acc -> binder acc) ctorInitActionsPre ctorBody

        // Add the final wrapping to make this into a method
        let ctorBody = mkMemberLambdas g m [] thisValOpt ctorInfo.InstanceCtorBaseValOpt [ctorInfo.InstanceCtorArgs] (ctorBody, g.unit_ty)

        Some ctorBody

    let cctorBodyOpt =
        // Omit the .cctor if it's empty
        match cctorInitActions with
        | [] -> None 
        | _ -> 
            let cctorInitAction = List.foldBack (fun (_, binder) acc -> binder acc) cctorInitActions (mkUnit g m)
            let cctorArgs, cctorVal, _ = staticCtorInfo.StaticCtorValInfo.Force()
            // Reconstitute the type of the implicit class constructor with the correct quantified type variables.
            cctorVal.SetType (mkForallTyIfNeeded ctorDeclaredTypars cctorVal.TauType)
            let cctorBody = mkMemberLambdas g m [] None None [cctorArgs] (cctorInitAction, g.unit_ty)
            Some cctorBody
        
    ctorBodyOpt, cctorBodyOpt, methodBinds, reps
