Skip to content
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
62 changes: 33 additions & 29 deletions src/Compiler/Checking/FindUnsolved.fs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ 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
Expand All @@ -29,14 +30,17 @@ type cenv =
override _.ToString() = "<cenv>"

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

let accTypeInst cenv env tyargs =
tyargs |> List.iter (accTy cenv env)
tyargs |> List.iter (accTy cenv env None)

/// Walk expressions, collecting type variables
let rec accExpr (cenv: cenv) (env: env) expr =
Expand All @@ -52,17 +56,17 @@ let rec accExpr (cenv: cenv) (env: env) expr =
accBind cenv env bind
accExpr cenv env body

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

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

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

| Expr.Obj (_, ty, basev, basecall, overrides, iimpls, _m) ->
accTy cenv env ty
| Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) ->
accTy cenv env (Some m) ty
accExpr cenv env basecall
accMethods cenv env basev overrides
accIntfImpls cenv env basev iimpls
Expand All @@ -77,8 +81,8 @@ let rec accExpr (cenv: cenv) (env: env) expr =
| Expr.Op (c, tyargs, args, m) ->
accOp cenv env (c, tyargs, args, m)

| Expr.App (f, fty, tyargs, argsl, _m) ->
accTy cenv env fty
| Expr.App (f, fty, tyargs, argsl, m) ->
accTy cenv env (Some m) fty
accTypeInst cenv env tyargs
accExpr cenv env f
accExprs cenv env argsl
Expand All @@ -88,33 +92,33 @@ let rec accExpr (cenv: cenv) (env: env) expr =
let ty = mkMultiLambdaTy cenv.g m argvs bodyTy
accLambdas cenv env valReprInfo expr ty

| Expr.TyLambda (_, tps, _body, _m, bodyTy) ->
| Expr.TyLambda (_, tps, _body, m, bodyTy) ->
let valReprInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal)
accTy cenv env bodyTy
accTy cenv env (Some 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 ty
accTy cenv env (Some 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) ->
| Expr.StaticOptimization (constraints, e2, e3, m) ->
accExpr cenv env e2
accExpr cenv env e3
constraints |> List.iter (function
| TTyconEqualsTycon(ty1, ty2) ->
accTy cenv env ty1
accTy cenv env ty2
accTy cenv env (Some m) ty1
accTy cenv env (Some m) ty2
| TTyconIsStruct(ty1) ->
accTy cenv env ty1)
accTy cenv env (Some m) ty1)

| Expr.WitnessArg (traitInfo, _m) ->
accTraitInfo cenv env traitInfo
Expand All @@ -136,7 +140,7 @@ and accIntfImpls cenv env baseValOpt l =
List.iter (accIntfImpl cenv env baseValOpt) l

and accIntfImpl cenv env baseValOpt (ty, overrides) =
accTy cenv env ty
accTy cenv env None ty
accMethods cenv env baseValOpt overrides

and accOp cenv env (op, tyargs, args, _m) =
Expand All @@ -158,16 +162,16 @@ and accOp cenv env (op, tyargs, args, _m) =

and accTraitInfo cenv env (TTrait(tys, _nm, _, argTys, retTy, _sln)) =
argTys |> accTypeInst cenv env
retTy |> Option.iter (accTy cenv env)
tys |> List.iter (accTy cenv env)
retTy |> Option.iter (accTy cenv env None)
tys |> List.iter (accTy cenv env None)

and accLambdas cenv env valReprInfo expr exprTy =
match stripDebugPoints expr with
| Expr.TyChoose (_tps, bodyExpr, _m) -> accLambdas cenv env valReprInfo bodyExpr exprTy
| Expr.Lambda _
| Expr.TyLambda _ ->
| 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 bodyTy
accTy cenv env (Some range) bodyTy
vsl |> List.iterSquared (accVal cenv env)
baseValOpt |> Option.iter (accVal cenv env)
ctorThisValOpt |> Option.iter (accVal cenv env)
Expand Down Expand Up @@ -198,23 +202,23 @@ and accSwitch cenv env (e, cases, dflt, _m) =
and accDiscrim cenv env d =
match d with
| DecisionTreeTest.UnionCase(_ucref, tinst) -> accTypeInst cenv env tinst
| DecisionTreeTest.ArrayLength(_, ty) -> accTy cenv env ty
| DecisionTreeTest.ArrayLength(_, ty) -> accTy cenv env None ty
| DecisionTreeTest.Const _
| DecisionTreeTest.IsNull -> ()
| DecisionTreeTest.IsInst (srcTy, tgtTy) -> accTy cenv env srcTy; accTy cenv env tgtTy
| DecisionTreeTest.IsInst (srcTy, tgtTy) -> accTy cenv env None srcTy; accTy cenv env None tgtTy
| DecisionTreeTest.ActivePatternCase (exp, tys, _, _, _, _) ->
accExpr cenv env exp
accTypeInst cenv env tys
| DecisionTreeTest.Error _ -> ()

and accAttrib cenv env (Attrib(_, _k, args, props, _, _, _m)) =
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 ty)
accTy cenv env (Some m) ty)

and accAttribs cenv env attribs =
List.iter (accAttrib cenv env) attribs
Expand All @@ -229,7 +233,7 @@ and accArgReprInfo cenv env (argInfo: ArgReprInfo) =
and accVal cenv env v =
v.Attribs |> accAttribs cenv env
v.ValReprInfo |> Option.iter (accValReprInfo cenv env)
v.Type |> accTy cenv env
v.Type |> accTy cenv env None

and accBind cenv env (bind: Binding) =
accVal cenv env bind.Var
Expand Down