Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Witnesses made visible in FCS #9510

Merged
merged 14 commits into from
Nov 3, 2020
Merged

Witnesses made visible in FCS #9510

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
14 commits
Select commit Hold shift + click to select a range
de9923d
witnesses made visible in FCS
dsyme Jun 19, 2020
46ba75a
Merge branch 'main' of https://github.com/dotnet/fsharp into feature/…
dsyme Sep 6, 2020
0e81647
Merge branch 'main' of https://github.com/dotnet/fsharp into feature/…
dsyme Sep 22, 2020
9ff1bfb
update baselines
dsyme Sep 22, 2020
8640a8d
merge main
Oct 23, 2020
fd6a290
fix build
Oct 23, 2020
fa405cc
add testing
Oct 24, 2020
1a8bb47
add testing
Oct 24, 2020
fc8479f
fix tests
Oct 25, 2020
f619ca0
fix tests
Oct 25, 2020
886205d
Merge branch 'main' of https://github.com/dotnet/fsharp into feature/…
Oct 28, 2020
c4b28a1
Fix Regression with quotations of List.sum on non-primitive type
Oct 30, 2020
c8d5dfd
further testing for FCS on List.sum on non-primitive type
Oct 30, 2020
812e67e
run Expr tests in independent checkers to get consistent names
Oct 30, 2020
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
95 changes: 75 additions & 20 deletions src/fsharp/symbols/Exprs.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@ namespace FSharp.Compiler.SourceCodeServices
open FSharp.Compiler
open FSharp.Compiler.AbstractIL.Internal.Library
open FSharp.Compiler.AbstractIL.IL
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Lib
open FSharp.Compiler.Infos
open FSharp.Compiler.QuotationTranslator
Expand Down Expand Up @@ -35,13 +36,26 @@ module ExprTranslationImpl =
isinstVals: ValMap<TType * Expr>

substVals: ValMap<Expr>

/// Indicates that we disable generation of witnesses
suppressWitnesses: bool

/// All witnesses in scope and their mapping to lambda variables.
//
// Note: this uses an immutable HashMap/Dictionary with an IEqualityComparer that captures TcGlobals, see
// the point where the empty initial object is created.
witnessesInScope: TraitWitnessInfoHashMap<int>

}

static member Empty =
static member Empty g =
{ vs=ValMap<_>.Empty
tyvs = Map.empty ;
tyvs = Map.empty
isinstVals = ValMap<_>.Empty
substVals = ValMap<_>.Empty }
substVals = ValMap<_>.Empty
suppressWitnesses = false
witnessesInScope = EmptyTraitWitnessInfoHashMap g
}

member env.BindTypar (v: Typar, gp) =
{ env with tyvs = env.tyvs.Add(v.Stamp, gp ) }
Expand Down Expand Up @@ -81,7 +95,7 @@ type E =
| IfThenElse of FSharpExpr * FSharpExpr * FSharpExpr
| DecisionTree of FSharpExpr * (FSharpMemberOrFunctionOrValue list * FSharpExpr) list
| DecisionTreeSuccess of int * FSharpExpr list
| Call of FSharpExpr option * FSharpMemberOrFunctionOrValue * FSharpType list * FSharpType list * FSharpExpr list
| Call of FSharpExpr option * FSharpMemberOrFunctionOrValue * FSharpType list * FSharpType list * FSharpExpr list * FSharpExpr list
| NewObject of FSharpMemberOrFunctionOrValue * FSharpType list * FSharpExpr list
| LetRec of ( FSharpMemberOrFunctionOrValue * FSharpExpr) list * FSharpExpr
| Let of (FSharpMemberOrFunctionOrValue * FSharpExpr) * FSharpExpr
Expand Down Expand Up @@ -117,6 +131,7 @@ type E =
| ILFieldGet of FSharpExpr option * FSharpType * string
| ILFieldSet of FSharpExpr option * FSharpType * string * FSharpExpr
| ILAsm of string * FSharpType list * FSharpExpr list
| WitnessArg of int

/// Used to represent the information at an object expression member
and [<Sealed>] FSharpObjectExprOverride(sgn: FSharpAbstractSignature, gps: FSharpGenericParameter list, args: FSharpMemberOrFunctionOrValue list list, body: FSharpExpr) =
Expand Down Expand Up @@ -150,7 +165,7 @@ and [<Sealed>] FSharpExpr (cenv, f: (unit -> FSharpExpr) option, e: E, m: range,
| E.NewUnionCase (_unionType, _unionCase, es) -> es
| E.NewTuple (_tupleType, es) -> es
| E.TupleGet (_tupleType, _itemIndex, tupleExpr) -> [tupleExpr]
| E.Call (objOpt, _b, _c, _d, es) -> (match objOpt with None -> es | Some x -> x :: es)
| E.Call (objOpt, _b, _c, _d, ws, es) -> (match objOpt with None -> ws @ es | Some x -> x :: ws @ es)
| E.NewObject (_a, _b, c) -> c
| E.FSharpFieldGet (objOpt, _b, _c) -> (match objOpt with None -> [] | Some x -> [x])
| E.FSharpFieldSet (objOpt, _b, _c, d) -> (match objOpt with None -> [d] | Some x -> [x;d])
Expand Down Expand Up @@ -187,7 +202,7 @@ and [<Sealed>] FSharpExpr (cenv, f: (unit -> FSharpExpr) option, e: E, m: range,
| E.UnionCaseSet (obj, _unionType, _unionCase, _unionField, valueExpr) -> [ yield obj; yield valueExpr ]
| E.TraitCall (_sourceTypes, _traitName, _memberFlags, _paramTypes, _retTypes, args) -> args
| E.Unused -> [] // unexpected

| E.WitnessArg _n -> []

/// The implementation of the conversion operation
module FSharpExprConvert =
Expand Down Expand Up @@ -409,19 +424,19 @@ module FSharpExprConvert =
let (numEnclTypeArgs, _, isNewObj, _valUseFlags, _isSelfInit, takesInstanceArg, _isPropGet, _isPropSet) =
GetMemberCallInfo cenv.g (vref, vFlags)

let isMember, curriedArgInfos =
let isMember, tps, curriedArgInfos =

match vref.MemberInfo with
| Some _ when not vref.IsExtensionMember ->
// This is an application of a member method
// We only count one argument block for these.
let _tps, curriedArgInfos, _, _ = GetTypeOfMemberInFSharpForm cenv.g vref
true, curriedArgInfos
let tps, curriedArgInfos, _, _ = GetTypeOfMemberInFSharpForm cenv.g vref
true, tps, curriedArgInfos
| _ ->
// This is an application of a module value or extension member
let arities = arityOfVal vref.Deref
let _tps, curriedArgInfos, _, _ = GetTopValTypeInFSharpForm cenv.g arities vref.Type m
false, curriedArgInfos
let tps, curriedArgInfos, _, _ = GetTopValTypeInFSharpForm cenv.g arities vref.Type m
false, tps, curriedArgInfos

// Compute the object arguments as they appear in a compiled call
// Strip off the object argument, if any. The curriedArgInfos are already adjusted to compiled member form
Expand Down Expand Up @@ -467,12 +482,30 @@ module FSharpExprConvert =
if isMember then
let callArgs = (objArgs :: untupledCurriedArgs) |> List.concat
let enclTyArgs, methTyArgs = List.splitAfter numEnclTypeArgs tyargs
let witnessArgsR = GetWitnessArgs cenv env m tps tyargs
// tailcall
ConvObjectModelCallLinear cenv env (isNewObj, FSharpMemberOrFunctionOrValue(cenv, vref), enclTyArgs, methTyArgs, callArgs) contf2
ConvObjectModelCallLinear cenv env (isNewObj, FSharpMemberOrFunctionOrValue(cenv, vref), enclTyArgs, methTyArgs, witnessArgsR, callArgs) contf2
else
let v = FSharpMemberOrFunctionOrValue(cenv, vref)
let witnessArgsR = GetWitnessArgs cenv env m vref.Typars tyargs
// tailcall
ConvObjectModelCallLinear cenv env (false, v, [], tyargs, List.concat untupledCurriedArgs) contf2
ConvObjectModelCallLinear cenv env (false, v, [], tyargs, witnessArgsR, List.concat untupledCurriedArgs) contf2

and GetWitnessArgs cenv (env: ExprTranslationEnv) m tps tyargs : FSharpExpr list =
let g = cenv.g
if cenv.g.langVersion.SupportsFeature(Features.LanguageFeature.WitnessPassing) && not env.suppressWitnesses then
let witnessExprs =
ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcValF g cenv.amap m tps tyargs
|> CommitOperationResult
let env = { env with suppressWitnesses = true }
witnessExprs |> List.map (fun arg ->
match arg with
| Choice1Of2 traitInfo ->
ConvWitnessInfo cenv env m traitInfo
| Choice2Of2 arg ->
ConvExpr cenv env arg)
else
[]

and ConvExprPrim (cenv: SymbolEnv) (env: ExprTranslationEnv) expr =
// Eliminate integer 'for' loops
Expand Down Expand Up @@ -554,7 +587,7 @@ module FSharpExprConvert =
let vslR = List.map (List.map (ConvVal cenv)) tmvs
let sgn = FSharpAbstractSignature(cenv, slotsig)
let tpsR = [ for tp in tps -> FSharpGenericParameter(cenv, tp) ]
let env = ExprTranslationEnv.Empty.BindTypars (Seq.zip tps tpsR |> Seq.toList)
let env = env.BindTypars (Seq.zip tps tpsR |> Seq.toList)
let env = env.BindCurriedVals tmvs
let bodyR = ConvExpr cenv env body
FSharpObjectExprOverride(sgn, tpsR, vslR, bodyR) ]
Expand Down Expand Up @@ -841,9 +874,29 @@ module FSharpExprConvert =
ConvExprPrim cenv env replExpr

| _ -> wfail (sprintf "unhandled construct in AST", m)
| Expr.WitnessArg (traitInfo, _m) ->
ConvWitnessInfoPrim cenv env traitInfo
| _ ->
wfail (sprintf "unhandled construct in AST", expr.Range)

and ConvWitnessInfoPrim _cenv env traitInfo : E =
let witnessInfo = traitInfo.TraitKey
let env = { env with suppressWitnesses = true }
// First check if this is a witness in ReflectedDefinition code
if env.witnessesInScope.ContainsKey witnessInfo then
let witnessArgIdx = env.witnessesInScope.[witnessInfo]
E.WitnessArg(witnessArgIdx)
// Otherwise it is a witness in a quotation literal
else
//failwith "witness not found"
E.WitnessArg(-1)

and ConvWitnessInfo cenv env m traitInfo : FSharpExpr =
let g = cenv.g
let witnessInfo = traitInfo.TraitKey
let witnessTy = GenWitnessTy g witnessInfo
let traitInfoR = ConvWitnessInfoPrim cenv env traitInfo
Mk cenv m witnessTy traitInfoR

and ConvLetBind cenv env (bind : Binding) =
match bind.Expr with
Expand Down Expand Up @@ -895,7 +948,7 @@ module FSharpExprConvert =
let enclosingType = generalizedTyconRef tcref

let makeCall minfo =
ConvObjectModelCallLinear cenv env (isNewObj, minfo, enclTypeArgs, methTypeArgs, callArgs) id
ConvObjectModelCallLinear cenv env (isNewObj, minfo, enclTypeArgs, methTypeArgs, [], callArgs) id

let makeFSCall isMember (vr: ValRef) =
let memOrVal =
Expand Down Expand Up @@ -1079,7 +1132,7 @@ module FSharpExprConvert =
with e ->
failwithf "An IL call to '%s' could not be resolved: %s" (ilMethRef.ToString()) e.Message

and ConvObjectModelCallLinear cenv env (isNewObj, v: FSharpMemberOrFunctionOrValue, enclTyArgs, methTyArgs, callArgs) contF =
and ConvObjectModelCallLinear cenv env (isNewObj, v: FSharpMemberOrFunctionOrValue, enclTyArgs, methTyArgs, witnessArgsR: FSharpExpr list, callArgs) contF =
let enclTyArgsR = ConvTypes cenv enclTyArgs
let methTyArgsR = ConvTypes cenv methTyArgs
let obj, callArgs =
Expand All @@ -1095,7 +1148,7 @@ module FSharpExprConvert =
if isNewObj then
E.NewObject(v, enclTyArgsR, callArgsR)
else
E.Call(objR, v, enclTyArgsR, methTyArgsR, callArgsR))
E.Call(objR, v, enclTyArgsR, methTyArgsR, witnessArgsR, callArgsR))


and ConvExprs cenv env args = List.map (ConvExpr cenv env) args
Expand Down Expand Up @@ -1255,7 +1308,7 @@ and FSharpImplementationFileContents(cenv, mimpl) =
let v = FSharpMemberOrFunctionOrValue(cenv, mkLocalValRef v)
let gps = v.GenericParameters
let vslR = List.map (List.map (FSharpExprConvert.ConvVal cenv)) vsl
let env = ExprTranslationEnv.Empty.BindTypars (Seq.zip tps gps |> Seq.toList)
let env = ExprTranslationEnv.Empty(cenv.g).BindTypars (Seq.zip tps gps |> Seq.toList)
let env = env.BindCurriedVals vsl
let e = FSharpExprConvert.ConvExprOnDemand cenv env body
FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(v, vslR, e)
Expand All @@ -1277,7 +1330,7 @@ and FSharpImplementationFileContents(cenv, mimpl) =
| TMDefLet(bind, _m) ->
[ yield getBind bind ]
| TMDefDo(expr, _m) ->
[ let expr = FSharpExprConvert.ConvExprOnDemand cenv ExprTranslationEnv.Empty expr
[ let expr = FSharpExprConvert.ConvExprOnDemand cenv (ExprTranslationEnv.Empty(cenv.g)) expr
yield FSharpImplementationFileDeclaration.InitAction expr ]
| TMDefs mdefs ->
[ for mdef in mdefs do yield! getDecls mdef ]
Expand All @@ -1303,7 +1356,8 @@ module BasicPatterns =
let (|NewUnionCase|_|) (e: FSharpExpr) = match e.E with E.NewUnionCase (e, tys, es) -> Some (e, tys, es) | _ -> None
let (|NewTuple|_|) (e: FSharpExpr) = match e.E with E.NewTuple (ty, es) -> Some (ty, es) | _ -> None
let (|TupleGet|_|) (e: FSharpExpr) = match e.E with E.TupleGet (ty, n, es) -> Some (ty, n, es) | _ -> None
let (|Call|_|) (e: FSharpExpr) = match e.E with E.Call (a, b, c, d, e) -> Some (a, b, c, d, e) | _ -> None
let (|Call|_|) (e: FSharpExpr) = match e.E with E.Call (a, b, c, d, _e, f) -> Some (a, b, c, d, f) | _ -> None
let (|CallWithWitnesses|_|) (e: FSharpExpr) = match e.E with E.Call (a, b, c, d, e, f) -> Some (a, b, c, d, e, f) | _ -> None
let (|NewObject|_|) (e: FSharpExpr) = match e.E with E.NewObject (a, b, c) -> Some (a, b, c) | _ -> None
let (|FSharpFieldGet|_|) (e: FSharpExpr) = match e.E with E.FSharpFieldGet (a, b, c) -> Some (a, b, c) | _ -> None
let (|AnonRecordGet|_|) (e: FSharpExpr) = match e.E with E.AnonRecordGet (a, b, c) -> Some (a, b, c) | _ -> None
Expand Down Expand Up @@ -1335,4 +1389,5 @@ module BasicPatterns =
let (|DecisionTreeSuccess|_|) (e: FSharpExpr) = match e.E with E.DecisionTreeSuccess (a, b) -> Some (a, b) | _ -> None
let (|UnionCaseSet|_|) (e: FSharpExpr) = match e.E with E.UnionCaseSet (a, b, c, d, e) -> Some (a, b, c, d, e) | _ -> None
let (|TraitCall|_|) (e: FSharpExpr) = match e.E with E.TraitCall (a, b, c, d, e, f) -> Some (a, b, c, d, e, f) | _ -> None
let (|WitnessArg|_|) (e: FSharpExpr) = match e.E with E.WitnessArg n -> Some n | _ -> None

12 changes: 9 additions & 3 deletions src/fsharp/symbols/Exprs.fsi
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.

namespace FSharp.Compiler.SourceCodeServices
namespace rec FSharp.Compiler.SourceCodeServices

open FSharp.Compiler.CompileOps
open FSharp.Compiler.Range
Expand All @@ -17,7 +17,7 @@ type public FSharpAssemblyContents =
member ImplementationFiles: FSharpImplementationFileContents list

/// Represents the definitional contents of a single file or fragment in an assembly, as seen by the F# language
and [<Class>] public FSharpImplementationFileContents =
type public FSharpImplementationFileContents =
internal new : cenv: SymbolEnv * mimpl: TypedImplFile -> FSharpImplementationFileContents

/// The qualified name acts to fully-qualify module specifications and implementations
Expand Down Expand Up @@ -52,7 +52,8 @@ and public FSharpImplementationFileDeclaration =
///
/// Pattern matching is reduced to decision trees and conditional tests. Some other
/// constructs may be represented in reduced form.
and [<Sealed>] public FSharpExpr =
[<Sealed>]
type public FSharpExpr =
/// The range of the expression
member Range : range

Expand Down Expand Up @@ -108,6 +109,9 @@ module public BasicPatterns =
/// arguments are collapsed to a single collection of arguments, as done in the compiled version of these.
val (|Call|_|) : FSharpExpr -> (FSharpExpr option * FSharpMemberOrFunctionOrValue * FSharpType list * FSharpType list * FSharpExpr list) option

/// Like Call but also indicates witness arguments
val (|CallWithWitnesses|_|) : FSharpExpr -> (FSharpExpr option * FSharpMemberOrFunctionOrValue * FSharpType list * FSharpType list * FSharpExpr list * FSharpExpr list) option

/// Matches expressions which are calls to object constructors
val (|NewObject|_|) : FSharpExpr -> (FSharpMemberOrFunctionOrValue * FSharpType list * FSharpExpr list) option

Expand Down Expand Up @@ -218,3 +222,5 @@ module public BasicPatterns =
/// Matches expressions for an unresolved call to a trait
val (|TraitCall|_|) : FSharpExpr -> (FSharpType list * string * MemberFlags * FSharpType list * FSharpType list * FSharpExpr list) option

/// Indicates a witness argument index from the witness arguments supplied to the enclosing method
val (|WitnessArg|_|) : FSharpExpr -> int option
Loading