Skip to content

Commit

Permalink
More cleanup (#13123)
Browse files Browse the repository at this point in the history 
* fix merge problem

* fix merge problem

* more cleanup

* more cleanup

* improve CheckExpressions

* format

* fix build

* remove ModuleOrNamespaceExprWithSig and put it in CheckedImplFile

* format

* cleanup the cleanup
  • Loading branch information
@dsyme
dsyme committed May 11, 2022
1 parent b9556cc commit e063dd2
Show file tree
Hide file tree
Showing 126 changed files with 4,290 additions and 3,661 deletions.
3 changes: 2 additions & 1 deletion .vscode/settings.json
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,5 +45,6 @@
"MD025": {
"front_matter_title": ""
}
}
},
"editor.inlayHints.enabled": "offUnlessPressed"
}
2 changes: 1 addition & 1 deletion DEVGUIDE.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -290,7 +290,7 @@ Existing compiler benchmarks can be found in `tests\benchmarks\`.
{
SourceFiles = [|"CheckExpressions.fs"|]
ConditionalDefines = []
ErrorSeverityOptions = FSharpDiagnosticOptions.Default
DiagnosticOptions = FSharpDiagnosticOptions.Default
LangVersionText = "default"
IsInteractive = false
LightSyntax = None
Expand Down
2 changes: 2 additions & 0 deletions release-notes.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,8 @@ These release notes track our current efforts to document changes to the F# proj
A 'do expr' declaration in a module will correspond to a SynModuleDecl.Expr enclosing a SynExpr.Do
This constructo also loses the debug point as it was always None. The debug point
is always implicit for this construct.
* In FCS API, FSharpParsingOptions, `CompilingFsLib` --> `CompilingFSharpCore`
* In FCS API, FSharpParsingOptions, `ErrorSeverityOptions` --> `DiagnosticOptions`

### F# 6.0 / Visual Studio 17.0

Expand Down
12 changes: 6 additions & 6 deletions src/Compiler/AbstractIL/il.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4019,7 +4019,7 @@ type ILTypeSigParser (tstring : string) =
| None -> []
| Some genericArgs -> genericArgs
let tspec = ILTypeSpec.Create (tref, genericArgs)
let ilty =
let ilTy =
match tspec.Name with
| "System.SByte"
| "System.Byte"
Expand All @@ -4037,13 +4037,13 @@ type ILTypeSigParser (tstring : string) =

// if it's an array, wrap it - otherwise, just return the IL type
match rank with
| Some r -> ILType.Array (r, ilty)
| _ -> ilty
| Some r -> ILType.Array (r, ilTy)
| _ -> ilTy

member x.ParseTypeSpec() =
reset()
let ilty = x.ParseType()
ILAttribElem.Type (Some ilty)
let ilTy = x.ParseType()
ILAttribElem.Type (Some ilTy)

let decodeILAttribData (ca: ILAttribute) =
match ca with
Expand Down Expand Up @@ -4328,7 +4328,7 @@ and refsOfILCode s (c: ILCode) =

for exnClause in c.Exceptions do
match exnClause.Clause with
| ILExceptionClause.TypeCatch (ilty, _) -> refsOfILType s ilty
| ILExceptionClause.TypeCatch (ilTy, _) -> refsOfILType s ilTy
| _ -> ()

and refsOfILMethodBody s (il: ILMethodBody) =
Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/AbstractIL/ilmorph.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,7 @@ let code_instr2instr_ty2ty (finstr,fTy) (code: ILCode) =
[ for exnSpec in codeR.Exceptions do
let clause =
match exnSpec.Clause with
| ILExceptionClause.TypeCatch (ilty, b) -> ILExceptionClause.TypeCatch (fTy ilty, b)
| ILExceptionClause.TypeCatch (ilTy, b) -> ILExceptionClause.TypeCatch (fTy ilTy, b)
| cl -> cl
{ exnSpec with Clause = clause } ]
{ codeR with Exceptions = exnSpecsR }
Expand Down
12 changes: 6 additions & 6 deletions src/Compiler/AbstractIL/ilread.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3678,13 +3678,13 @@ let openPEFileReader (fileName, pefile: BinaryFile, pdbDirPath, noFileOnDisk) =
(* PE SIGNATURE *)
let machine = seekReadUInt16AsInt32 pev (peFileHeaderPhysLoc + 0)
let numSections = seekReadUInt16AsInt32 pev (peFileHeaderPhysLoc + 2)
let optHeaderSize = seekReadUInt16AsInt32 pev (peFileHeaderPhysLoc + 16)
if optHeaderSize <> 0xe0 &&
optHeaderSize <> 0xf0 then failwith "not a PE file - bad optional header size"
let x64adjust = optHeaderSize - 0xe0
let only64 = (optHeaderSize = 0xf0) (* May want to read in the optional header Magic number and check that as well... *)
let headerSizeOpt = seekReadUInt16AsInt32 pev (peFileHeaderPhysLoc + 16)
if headerSizeOpt <> 0xe0 &&
headerSizeOpt <> 0xf0 then failwith "not a PE file - bad optional header size"
let x64adjust = headerSizeOpt - 0xe0
let only64 = (headerSizeOpt = 0xf0) (* May want to read in the optional header Magic number and check that as well... *)
let platform = match machine with | 0x8664 -> Some AMD64 | 0x200 -> Some IA64 | _ -> Some X86
let sectionHeadersStartPhysLoc = peOptionalHeaderPhysLoc + optHeaderSize
let sectionHeadersStartPhysLoc = peOptionalHeaderPhysLoc + headerSizeOpt

let flags = seekReadUInt16AsInt32 pev (peFileHeaderPhysLoc + 18)
let isDll = (flags &&& 0x2000) <> 0x0
Expand Down
44 changes: 22 additions & 22 deletions src/Compiler/Checking/CheckComputationExpressions.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -662,22 +662,22 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol

let (|OptionalIntoSuffix|) e =
match e with
| IntoSuffix (body, intoWordRange, optInfo) -> (body, Some (intoWordRange, optInfo))
| IntoSuffix (body, intoWordRange, intoInfo) -> (body, Some (intoWordRange, intoInfo))
| body -> (body, None)

let (|CustomOperationClause|_|) e =
match e with
| OptionalIntoSuffix(StripApps(SingleIdent nm, _) as core, optInto) when isCustomOperation nm ->
| OptionalIntoSuffix(StripApps(SingleIdent nm, _) as core, intoOpt) when isCustomOperation nm ->
// Now we know we have a custom operation, commit the name resolution
let optIntoInfo =
match optInto with
| Some (intoWordRange, optInfo) ->
let intoInfoOpt =
match intoOpt with
| Some (intoWordRange, intoInfo) ->
let item = Item.CustomOperation ("into", (fun () -> None), None)
CallNameResolutionSink cenv.tcSink (intoWordRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights)
Some optInfo
Some intoInfo
| None -> None

Some (nm, Option.get (tryGetDataForCustomOperation nm), core, core.Range, optIntoInfo)
Some (nm, Option.get (tryGetDataForCustomOperation nm), core, core.Range, intoInfoOpt)
| _ -> None

let mkSynLambda p e m = SynExpr.Lambda (false, false, p, e, None, m, SynExprLambdaTrivia.Zero)
Expand Down Expand Up @@ -806,21 +806,21 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol
let varSpaceWithFirstVars =
addVarsToVarSpace varSpace (fun _mCustomOp env ->
use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv (firstSourcePat, None)
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv firstSourcePat None
vspecs, envinner)

let varSpaceWithSecondVars =
addVarsToVarSpace varSpaceWithFirstVars (fun _mCustomOp env ->
use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv (secondSourcePat, None)
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv secondSourcePat None
vspecs, envinner)

let varSpaceWithGroupJoinVars =
match secondResultPatOpt with
| Some pat3 ->
addVarsToVarSpace varSpaceWithFirstVars (fun _mCustomOp env ->
use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv (pat3, None)
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv pat3 None
vspecs, envinner)
| None -> varSpace

Expand Down Expand Up @@ -971,7 +971,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol
let varSpace =
addVarsToVarSpace varSpace (fun _mCustomOp env ->
use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv (pat, None)
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv pat None
vspecs, envinner)

Some (trans CompExprTranslationPass.Initial q varSpace innerComp
Expand Down Expand Up @@ -1191,7 +1191,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol
| [NormalizedBinding(_vis, SynBindingKind.Normal, false, false, _, _, _, _, pat, _, _, _)] ->
// successful case
use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv (pat, None)
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv pat None
vspecs, envinner
| _ ->
// error case
Expand Down Expand Up @@ -1224,7 +1224,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol
let varSpace =
addVarsToVarSpace varSpace (fun _mCustomOp env ->
use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv (pat, None)
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv pat None
vspecs, envinner)

let rhsExpr = mkSourceExprConditional isFromSource rhsExpr
Expand Down Expand Up @@ -1290,7 +1290,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol
let varSpace =
addVarsToVarSpace varSpace (fun _mCustomOp env ->
use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv (consumePat, None)
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv consumePat None
vspecs, envinner)

Some (transBind q varSpace mBind (addBindDebugPoint spBind) bindNName sources consumePat innerComp translatedCtxt)
Expand All @@ -1306,7 +1306,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol
let varSpace =
addVarsToVarSpace varSpace (fun _mCustomOp env ->
use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv (consumePat, None)
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv consumePat None
vspecs, envinner)

Some (transBind q varSpace mBind (addBindDebugPoint spBind) bindNName sources consumePat innerComp translatedCtxt)
Expand Down Expand Up @@ -1364,7 +1364,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol
let varSpace =
addVarsToVarSpace varSpace (fun _mCustomOp env ->
use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv (consumePat, None)
let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv consumePat None
vspecs, envinner)

// Build the 'Bind' call
Expand Down Expand Up @@ -1845,7 +1845,7 @@ let mkSeqFinally (cenv: cenv) env m genTy e1 e2 =
mkCallSeqFinally cenv.g m genResultTy e1 e2

let mkSeqExprMatchClauses (pat, vspecs) innerExpr =
[TClause(pat, None, TTarget(vspecs, innerExpr, None), pat.Range) ]
[MatchClause(pat, None, TTarget(vspecs, innerExpr, None), pat.Range) ]

let compileSeqExprMatchClauses (cenv: cenv) env inputExprMark (pat: Pattern, vspecs) innerExpr inputExprOpt bindPatTy genInnerTy =
let patMark = pat.Range
Expand Down Expand Up @@ -1888,7 +1888,7 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m =
// This expression is not checked with the knowledge it is an IEnumerable, since we permit other enumerable types with GetEnumerator/MoveNext methods, as does C#
let pseudoEnumExpr, arbitraryTy, tpenv = TcExprOfUnknownType cenv env tpenv pseudoEnumExpr
let enumExpr, enumElemTy = ConvertArbitraryExprToEnumerable cenv arbitraryTy env pseudoEnumExpr
let patR, _, vspecs, envinner, tpenv = TcMatchPattern cenv enumElemTy env tpenv (pat, None)
let patR, _, vspecs, envinner, tpenv = TcMatchPattern cenv enumElemTy env tpenv pat None
let innerExpr, tpenv =
let envinner = { envinner with eIsControlFlow = true }
tcSequenceExprBody envinner genOuterTy tpenv innerComp
Expand All @@ -1907,7 +1907,7 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m =
// "seq { .. for x in e1 do yield e2 .. }" == "e1 |> Seq.map (fun x -> e2)"
//
// This transformation is visible in quotations and thus needs to remain.
| (TPat_as (TPat_wild _, PBind (v, _), _),
| (TPat_as (TPat_wild _, PatternValBinding (v, _), _),
[_],
DebugPoints(Expr.App (Expr.Val (vf, _, _), _, [genEnumElemTy], [yieldExpr], _mYield), recreate))
when valRefEq cenv.g vf cenv.g.seq_singleton_vref ->
Expand Down Expand Up @@ -2021,7 +2021,7 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m =

let bindPatTy = NewInferenceType g
let inputExprTy = NewInferenceType g
let pat', _, vspecs, envinner, tpenv = TcMatchPattern cenv bindPatTy env tpenv (pat, None)
let pat', _, vspecs, envinner, tpenv = TcMatchPattern cenv bindPatTy env tpenv pat None

UnifyTypes cenv env m inputExprTy bindPatTy

Expand Down Expand Up @@ -2055,13 +2055,13 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m =

let tclauses, tpenv =
(tpenv, clauses) ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, _, sp, _)) ->
let patR, condR, vspecs, envinner, tpenv = TcMatchPattern cenv matchty env tpenv (pat, cond)
let patR, condR, vspecs, envinner, tpenv = TcMatchPattern cenv matchty env tpenv pat cond
let envinner =
match sp with
| DebugPointAtTarget.Yes -> { envinner with eIsControlFlow = true }
| DebugPointAtTarget.No -> envinner
let innerExpr, tpenv = tcSequenceExprBody envinner genOuterTy tpenv innerComp
TClause(patR, condR, TTarget(vspecs, innerExpr, None), patR.Range), tpenv)
MatchClause(patR, condR, TTarget(vspecs, innerExpr, None), patR.Range), tpenv)

let inputExprTy = tyOfExpr cenv.g inputExpr
let inputExprMark = inputExpr.Range
Expand Down
Loading

0 comments on commit e063dd2

Please sign in to comment.