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

/// Find unsolved, uninstantiated type variables
module internal FSharp.Compiler.FindUnsolved

open Internal.Utilities.Collections
open Internal.Utilities.Library
open Internal.Utilities.Library.Extras
open FSharp.Compiler
open FSharp.Compiler.DiagnosticsLogger
open FSharp.Compiler.Text
open FSharp.Compiler.TypedTree
open FSharp.Compiler.TypedTreeBasics
open FSharp.Compiler.TypedTreeOps
open FSharp.Compiler.TcGlobals
open FSharp.Compiler.TypeRelations

type env = | NoEnv

let FindUnsolvedStackGuardDepth = StackGuard.GetDepthOption "FindUnsolved"

/// The environment and collector
type cenv =
    { g: TcGlobals
      amap: Import.ImportMap
      denv: DisplayEnv
      mutable unsolved: Typars
      stackGuard: StackGuard }

    override _.ToString() = "<cenv>"

/// Walk types, collecting type variables
let accTy cenv _env (mFallback: range) ty =
    let normalizedTy = tryNormalizeMeasureInType cenv.g ty
    (freeInType CollectTyparsNoCaching normalizedTy).FreeTypars |> Zset.iter (fun tp ->
        if (tp.Rigidity <> TyparRigidity.Rigid) then
            match mFallback with
            | r when tp.Range = Range.range0 -> tp.SetIdent (FSharp.Compiler.Syntax.Ident(tp.typar_id.idText, r))
            | _ -> ()
            cenv.unsolved <- tp :: cenv.unsolved)

/// Walk type arguments, collecting type variables
let accTypeInst cenv env mFallback tyargs =
    tyargs |> List.iter (accTy cenv env mFallback)

/// Walk expressions, collecting type variables
let rec accExpr (cenv: cenv) (env: env) expr =
    cenv.stackGuard.Guard <| fun () ->

    let expr = stripExpr expr
    match expr with
    | Expr.Sequential (e1, e2, _, _) ->
        accExpr cenv env e1
        accExpr cenv env e2

    | Expr.Let (bind, body, _, _) ->
        accBind cenv env bind
        accExpr cenv env body

    | Expr.Const (_, r, ty) ->
        accTy cenv env r ty

    | Expr.Val (_v, _vFlags, _m) -> ()

    | Expr.Quote (ast, _, _, m, ty) ->
        accExpr cenv env ast
        accTy cenv env m ty

    | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) ->
        accTy cenv env m ty
        accExpr cenv env basecall
        accMethods cenv env basev overrides
        accIntfImpls cenv env basev m iimpls

    | LinearOpExpr (_op, tyargs, argsHead, argLast, m) ->
        // Note, LinearOpExpr doesn't include any of the "special" cases for accOp
        accTypeInst cenv env m tyargs
        accExprs cenv env argsHead
        // tailcall
        accExpr cenv env argLast

    | Expr.Op (c, tyargs, args, m) ->
        accOp cenv env (c, tyargs, args, m)

    | Expr.App (f, fty, tyargs, argsl, m) ->
        accTy cenv env m fty
        accTypeInst cenv env m tyargs
        accExpr cenv env f
        accExprs cenv env argsl

    | Expr.Lambda (_, _ctorThisValOpt, _baseValOpt, argvs, _body, m, bodyTy) ->
        let valReprInfo = ValReprInfo ([], [argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)], ValReprInfo.unnamedRetVal)
        let ty = mkMultiLambdaTy cenv.g m argvs bodyTy
        accLambdas cenv env valReprInfo expr ty

    | Expr.TyLambda (_, tps, _body, m, bodyTy)  ->
        let valReprInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal)
        accTy cenv env m bodyTy
        let ty = mkForallTyIfNeeded tps bodyTy
        accLambdas cenv env valReprInfo expr ty

    | Expr.TyChoose (_tps, e1, _m)  ->
        accExpr cenv env e1

    | Expr.Match (_, _exprm, dtree, targets, m, ty) ->
        accTy cenv env m ty
        accDTree cenv env dtree
        accTargets cenv env m ty targets

    | Expr.LetRec (binds, e, _m, _) ->
        accBinds cenv env binds
        accExpr cenv env e

    | Expr.StaticOptimization (constraints, e2, e3, m) ->
        accExpr cenv env e2
        accExpr cenv env e3
        constraints |> List.iter (function
            | TTyconEqualsTycon(ty1, ty2) ->
                accTy cenv env m ty1
                accTy cenv env m ty2
            | TTyconIsStruct(ty1) ->
                accTy cenv env m ty1)

    | Expr.WitnessArg (traitInfo, m) ->
        accTraitInfo cenv env m traitInfo

    | Expr.Link eref ->
        accExpr cenv env eref.Value

    | Expr.DebugPoint (_, innerExpr) ->
        accExpr cenv env innerExpr

/// Walk methods, collecting type variables
and accMethods cenv env baseValOpt l =
    List.iter (accMethod cenv env baseValOpt) l

/// Walk a method, collecting type variables
and accMethod cenv env _baseValOpt (TObjExprMethod(_slotsig, _attribs, _tps, vs, bodyExpr, _m)) =
    vs |> List.iterSquared (accVal cenv env)
    accExpr cenv env bodyExpr

/// Walk interface implementations, collecting type variables
and accIntfImpls cenv env baseValOpt (mFallback: range) l =
    List.iter (accIntfImpl cenv env baseValOpt mFallback) l

/// Walk an interface implementation, collecting type variables
and accIntfImpl cenv env (baseValOpt: Val option) (mFallback: range) (ty, overrides) =
    accTy cenv env mFallback ty
    accMethods cenv env baseValOpt overrides

/// Walk an operation, collecting type variables
and accOp cenv env (op, tyargs, args, m) =
    // Special cases
    accTypeInst cenv env m tyargs
    accExprs cenv env args
    match op with
    // Handle these as special cases since mutables are allowed inside their bodies
    | TOp.ILCall (_, _, _, _, _, _, _, _, enclTypeInst, methInst, retTys) ->
        accTypeInst cenv env m enclTypeInst
        accTypeInst cenv env m methInst
        accTypeInst cenv env m retTys
    | TOp.TraitCall traitInfo ->
        accTraitInfo cenv env m traitInfo

    | TOp.ILAsm (_, retTys) ->
        accTypeInst cenv env m retTys
    | _ ->    ()

/// Walk a trait call, collecting type variables
and accTraitInfo cenv env (mFallback : range) (TTrait(tys=tys; objAndArgTys=argTys; returnTyOpt=retTy)) =
    argTys |> accTypeInst cenv env mFallback
    retTy |> Option.iter (accTy cenv env mFallback)
    tys |> List.iter (accTy cenv env mFallback)

/// Walk lambdas, collecting type variables
and accLambdas cenv env valReprInfo expr exprTy =
    match stripDebugPoints expr with
    | Expr.TyChoose (_tps, bodyExpr, _m)  -> accLambdas cenv env valReprInfo bodyExpr exprTy
    | Expr.Lambda (range = range)
    | Expr.TyLambda (range = range) ->
        let _tps, ctorThisValOpt, baseValOpt, vsl, body, bodyTy = destLambdaWithValReprInfo cenv.g cenv.amap valReprInfo (expr, exprTy)
        accTy cenv env range bodyTy
        vsl |> List.iterSquared (accVal cenv env)
        baseValOpt |> Option.iter (accVal cenv env)
        ctorThisValOpt |> Option.iter (accVal cenv env)
        accExpr cenv env body
    | _ ->
        accExpr cenv env expr

/// Walk a list of expressions, collecting type variables
and accExprs cenv env exprs =
    exprs |> List.iter (accExpr cenv env)

/// Walk match targets, collecting type variables
and accTargets cenv env m ty targets =
    Array.iter (accTarget cenv env m ty) targets

/// Walk a match target, collecting type variables
and accTarget cenv env _m _ty (TTarget(_vs, e, _)) =
    accExpr cenv env e

/// Walk a decision tree, collecting type variables
and accDTree cenv env dtree =
    match dtree with
    | TDSuccess (es, _n) -> accExprs cenv env es
    | TDBind(bind, rest) -> accBind cenv env bind; accDTree cenv env rest
    | TDSwitch (e, cases, dflt, m) -> accSwitch cenv env (e, cases, dflt, m)

/// Walk a switch, collecting type variables
and accSwitch cenv env (e, cases, dflt, m) =
    accExpr cenv env e
    cases |> List.iter (fun (TCase(discrim, e)) -> accDiscrim cenv env discrim m; accDTree cenv env e)
    dflt |> Option.iter (accDTree cenv env)

/// Walk a discriminator, collecting type variables
and accDiscrim cenv env d mFallback =
    match d with
    | DecisionTreeTest.UnionCase(_ucref, tinst) -> accTypeInst cenv env mFallback tinst
    | DecisionTreeTest.ArrayLength(_, ty) -> accTy cenv env mFallback ty
    | DecisionTreeTest.Const _
    | DecisionTreeTest.IsNull -> ()
    | DecisionTreeTest.IsInst (srcTy, tgtTy) -> accTy cenv env mFallback srcTy; accTy cenv env mFallback tgtTy
    | DecisionTreeTest.ActivePatternCase (exp, tys, _, _, _, _) ->
        accExpr cenv env exp
        accTypeInst cenv env mFallback tys
    | DecisionTreeTest.Error _ -> ()

/// Walk an attribute, collecting type variables
and accAttrib cenv env (Attrib(_, _k, args, props, _, _, m)) =
    args |> List.iter (fun (AttribExpr(expr1, expr2)) ->
        accExpr cenv env expr1
        accExpr cenv env expr2)
    props |> List.iter (fun (AttribNamedArg(_nm, ty, _flg, AttribExpr(expr, expr2))) ->
        accExpr cenv env expr
        accExpr cenv env expr2
        accTy cenv env m ty)

/// Walk a list of attributes, collecting type variables
and accAttribs cenv env attribs =
    List.iter (accAttrib cenv env) attribs

/// Walk a value representation info, collecting type variables
and accValReprInfo cenv env (ValReprInfo(_, args, ret)) =
    args |> List.iterSquared (accArgReprInfo cenv env)
    ret |> accArgReprInfo cenv env

/// Walk an argument representation info, collecting type variables
and accArgReprInfo cenv env (argInfo: ArgReprInfo) =
    accAttribs cenv env argInfo.Attribs

/// Walk a value, collecting type variables
and accVal cenv env v =
    v.Attribs |> accAttribs cenv env
    v.ValReprInfo |> Option.iter (accValReprInfo cenv env)
    v.Type |> accTy cenv env v.Range

/// Walk a binding, collecting type variables
and accBind cenv env (bind: Binding) =
    accVal cenv env bind.Var
    let valReprInfo  = match bind.Var.ValReprInfo with Some info -> info | _ -> ValReprInfo.emptyValData
    accLambdas cenv env valReprInfo bind.Expr bind.Var.Type

/// Walk a list of bindings, collecting type variables
and accBinds cenv env binds =
    binds |> List.iter (accBind cenv env)

/// Walk a record field of a type constructor, collecting type variables
let accTyconRecdField cenv env _tycon (rfield:RecdField) =
    accAttribs cenv env rfield.PropertyAttribs
    accAttribs cenv env rfield.FieldAttribs

/// Walk a type constructor, collecting type variables
let accTycon cenv env (tycon:Tycon) =
    accAttribs cenv env tycon.Attribs
    abstractSlotValsOfTycons [tycon] |> List.iter (accVal cenv env)
    tycon.AllFieldsArray |> Array.iter (accTyconRecdField cenv env tycon)
    if tycon.IsUnionTycon then                             (* This covers finite unions. *)
      tycon.UnionCasesArray |> Array.iter (fun uc ->
          accAttribs cenv env uc.Attribs
          uc.RecdFieldsArray |> Array.iter (accTyconRecdField cenv env tycon))

/// Walk a list of type constructors, collecting type variables
let accTycons cenv env tycons =
    List.iter (accTycon cenv env) tycons

/// Walk a list of module or namespace definitions, collecting type variables
let rec accModuleOrNamespaceDefs cenv env defs =
    List.iter (accModuleOrNamespaceDef cenv env) defs

/// Walk a module or namespace definition, collecting type variables
and accModuleOrNamespaceDef cenv env def =
    match def with
    | TMDefRec(_, _opens, tycons, mbinds, _m) ->
        accTycons cenv env tycons
        accModuleOrNamespaceBinds cenv env mbinds
    | TMDefLet(bind, _m)  -> accBind cenv env bind
    | TMDefDo(e, _m)  -> accExpr cenv env e
    | TMDefOpens _ -> ()
    | TMDefs defs -> accModuleOrNamespaceDefs cenv env defs

/// Walk a list of module or namespace bindings, collecting type variables
and accModuleOrNamespaceBinds cenv env xs =
    List.iter (accModuleOrNamespaceBind cenv env) xs

/// Walk a module or namespace binding, collecting type variables
and accModuleOrNamespaceBind cenv env x =
    match x with
    | ModuleOrNamespaceBinding.Binding bind ->
        accBind cenv env bind
    | ModuleOrNamespaceBinding.Module(mspec, rhs) ->
        accTycon cenv env mspec
        accModuleOrNamespaceDef cenv env rhs

/// Find all unsolved inference variables after type inference for an entire file
let UnsolvedTyparsOfModuleDef g amap denv mdef extraAttribs =
    let cenv =
        { g =g
          amap=amap
          denv=denv
          unsolved = []
          stackGuard = StackGuard(FindUnsolvedStackGuardDepth, "UnsolvedTyparsOfModuleDef") }
    accModuleOrNamespaceDef cenv NoEnv mdef
    accAttribs cenv NoEnv extraAttribs
    List.rev cenv.unsolved


