Skip to content

Commit dbf9a62

Browse files
dsymeDon Syme
andauthored
fix issues related to witnesses for generated constructs - 10408 and 10389 (#11388)
* fix-10408 * fix-10408 * Update QuotationTranslator.fs Co-authored-by: Don Syme <donsyme@fastmail.com>
1 parent 5dab0a0 commit dbf9a62

File tree

4 files changed

+78
-4
lines changed

4 files changed

+78
-4
lines changed

src/fsharp/QuotationTranslator.fs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1087,6 +1087,8 @@ and ConvDecisionTree cenv env tgs typR x =
10871087
| _ ->
10881088
let ty = tyOfExpr cenv.g e1
10891089
let eq = mkCallEqualsOperator cenv.g m ty e1 (Expr.Const (Const.Zero, m, ty))
1090+
// no need to generate witnesses for generated equality operation calls, see https://github.com/dotnet/fsharp/issues/10389
1091+
let env = { env with suppressWitnesses = true }
10901092
let eqR = ConvExpr cenv env eq
10911093
QP.mkCond (eqR, ConvDecisionTree cenv env tgs typR dtree, acc)
10921094

src/fsharp/symbols/Exprs.fs

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -725,12 +725,14 @@ module FSharpExprConvert =
725725
let elemTy = tyOfExpr cenv.g arg
726726
let nullVal = mkNull m elemTy
727727
let op = mkCallNotEqualsOperator cenv.g m elemTy arg nullVal
728+
let env = { env with suppressWitnesses=true }
728729
ConvExprPrim cenv env op
729730

730731
| TOp.ILAsm ([ I_ldlen; AI_conv DT_I4 ], _), _, [arr] ->
731732
let arrayTy = tyOfExpr cenv.g arr
732733
let elemTy = destArrayTy cenv.g arrayTy
733734
let op = mkCallArrayLength cenv.g m elemTy arr
735+
let env = { env with suppressWitnesses=true }
734736
ConvExprPrim cenv env op
735737

736738
| TOp.ILAsm ([ I_newarr (ILArrayShape [(Some 0, None)], _)], _), [elemTy], xa ->
@@ -777,8 +779,8 @@ module FSharpExprConvert =
777779
| TOp.ILAsm ([ ILConvertOp convertOp ], [TType_app (tcref,_)]), _, [arg] ->
778780
let ty = tyOfExpr cenv.g arg
779781
let op =
780-
if tyconRefEq cenv.g tcref cenv.g.char_tcr
781-
then mkCallToCharOperator cenv.g m ty arg
782+
if tyconRefEq cenv.g tcref cenv.g.char_tcr then
783+
mkCallToCharOperator cenv.g m ty arg
782784
else convertOp cenv.g m ty arg
783785
ConvExprPrim cenv env op
784786

@@ -1275,8 +1277,10 @@ module FSharpExprConvert =
12751277
E.IfThenElse (E.TypeTest (tyR, eR) |> Mk cenv m cenv.g.bool_ty, acc, ConvDecisionTree cenv env dtreeRetTy dtree m)
12761278
| _ ->
12771279
let ty = tyOfExpr cenv.g e1
1278-
let eq = mkCallEqualsOperator cenv.g m ty e1 (Expr.Const (Const.Zero, m, ty))
1279-
let eqR = ConvExpr cenv env eq
1280+
let eqR =
1281+
let eq = mkCallEqualsOperator cenv.g m ty e1 (Expr.Const (Const.Zero, m, ty))
1282+
let env = { env with suppressWitnesses = true }
1283+
ConvExpr cenv env eq
12801284
E.IfThenElse (eqR, ConvDecisionTree cenv env dtreeRetTy dtree m, acc)
12811285
| DecisionTreeTest.IsInst (_srcty, tgty) ->
12821286
let e1R = ConvExpr cenv env e1

tests/fsharp/core/quotes/test.fsx

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4106,6 +4106,18 @@ module QuotationOfComputationExpressionZipOperation =
41064106
[x, y])]))))])),
41074107
PropertyGet (None, builder, []))"""
41084108

4109+
module CheckEliminatedConstructs =
4110+
let isNullQuoted (ts : 't[]) =
4111+
<@
4112+
match ts with
4113+
| null -> true
4114+
| _ -> false
4115+
@>
4116+
4117+
let actual1 = ((isNullQuoted [| |]).ToString())
4118+
checkStrings "brewbreebrvwe1" actual1
4119+
"""IfThenElse (Call (None, op_Equality, [ValueWithName ([||], ts), Value (<null>)]),
4120+
Value (true), Value (false))"""
41094121

41104122
module TestAssemblyAttributes =
41114123
let attributes = System.Reflection.Assembly.GetExecutingAssembly().GetCustomAttributes(false)

tests/service/ExprTests.fs

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3509,3 +3509,59 @@ let ``Test ProjectForWitnesses3 GetWitnessPassingInfo`` () =
35093509
argText2 |> shouldEqual "type ^T -> ^T -> ^T"
35103510
end
35113511

3512+
//---------------------------------------------------------------------------------------------------------
3513+
// This project is for witness arguments, testing for https://github.com/dotnet/fsharp/issues/10364
3514+
3515+
module internal ProjectForWitnesses4 =
3516+
3517+
let fileSource1 = """
3518+
module M
3519+
3520+
let isEmptyArray x =
3521+
match x with
3522+
| [| |] -> x
3523+
| _ -> x
3524+
3525+
let isNull (ts : 't[]) =
3526+
match ts with
3527+
| null -> true
3528+
| _ -> false
3529+
3530+
let isNullQuoted (ts : 't[]) =
3531+
<@
3532+
match ts with
3533+
| null -> true
3534+
| _ -> false
3535+
@>
3536+
3537+
"""
3538+
3539+
let createOptions() = createOptionsAux [fileSource1] ["--langversion:preview"]
3540+
3541+
[<Test>]
3542+
let ``Test ProjectForWitnesses4 GetWitnessPassingInfo`` () =
3543+
let cleanup, options = ProjectForWitnesses4.createOptions()
3544+
use _holder = cleanup
3545+
let exprChecker = FSharpChecker.Create(keepAssemblyContents=true)
3546+
let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously
3547+
3548+
for e in wholeProjectResults.Diagnostics do
3549+
printfn "ProjectForWitnesses4 error: <<<%s>>>" e.Message
3550+
3551+
Assert.AreEqual(wholeProjectResults.Diagnostics.Length, 0)
3552+
3553+
wholeProjectResults.AssemblyContents.ImplementationFiles.Length |> shouldEqual 1
3554+
let file1 = wholeProjectResults.AssemblyContents.ImplementationFiles.[0]
3555+
3556+
let expected =
3557+
["type M";
3558+
"let isEmptyArray(x) = (if (if Operators.op_Inequality<'a Microsoft.FSharp.Core.[]> (x,dflt) then Operators.op_Equality<Microsoft.FSharp.Core.int> (ArrayModule.Length<'a> (x),0) else False) then x else x) @ (5,10--5,11)";
3559+
"let isNull(ts) = (if Operators.op_Equality<'t Microsoft.FSharp.Core.[]> (ts,dflt) then True else False) @ (10,10--10,12)";
3560+
"let isNullQuoted(ts) = quote((if Operators.op_Equality<'t Microsoft.FSharp.Core.[]> (ts,dflt) then True else False)) @ (15,4--19,6)"]
3561+
3562+
let actual =
3563+
printDeclarations None (List.ofSeq file1.Declarations)
3564+
|> Seq.toList
3565+
printfn "actual:\n\n%A" actual
3566+
actual
3567+
|> shouldPairwiseEqual expected

0 commit comments

Comments
 (0)